* fichier :  tokaflu.dgibi
OPTI ECHO 0;
graph = faux;
**** @ACBLM
DEBPROC @ACBLM VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
*
********************************************************************
* Procedure de changement de base. On passe de la base cartesienne *
* locale de l'objet modelise a la base cartesienne du maillage. L' *
* axe Y de la base locale est dirige du point de tangence vers le  *
* centre du plasma.          Alain MOAL (juillet-aout 1995)        *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.'CENTRE_PLASMA' ;
PTG = TAB1.'PT_TGPLASMA'   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
VECT0 = CP MOINS PTG ;
VX = COOR 1 VECT0    ;
VY = COOR 2 VECT0    ;
*
*---- calcul de l'angle de rotation dans le plan XY
SI ((VX EGA 0.) ET (VY EGA 0.)) ;
   ANG1 = 0. ;
SINON ;
   ANG1 = -1.* (ATG VX VY) ;
FINSI ;
*
SI ((VALEUR DIME) EGA 2) ;
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VZL ;
      VYL1 = VYL ;
      VZL1 = VXL * (-1.);
*     ---- rotation
      VXM = VXL1 * (COS ANG1)  + (VYL1 * (-1.) * (SIN ANG1));
      VYM = VXL1 * (SIN ANG1)  + (VYL1 * (COS ANG1)) ;
      VZM = VZL1 ;
   FINSI ;
   SI (EGA IPLAN 'THETACONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXM = VXL * (COS ANG1)  + (VYL * (-1.) * (SIN ANG1)) ;
      VYM = VXL * (SIN ANG1)  + (VYL * (COS ANG1)) ;
      VZM = VZL ;
   FINSI;
SINON ;
   VZ = COOR 3 VECT0 ;
*
*  ---- calcul de l'angle de rotation dans le plan Y1Z1
   VX1 = VX * (COS ANG1)         + (VY * (SIN ANG1))    ;
   VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1))    ;
   VZ1 =                                             VZ ;
*
   SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
      ANG2 = 0. ;
   SINON ;
      ANG2 = ATG VZ1 VY1 ;
   FINSI ;
*
*  ---- rotations
   VXL1 = VXL                                              ;
   VYL1 =     VYL * (COS ANG2) + (VZL * (-1.) * (SIN ANG2));
   VZL1 =     VYL * (SIN ANG2) + (VZL * (COS ANG2))        ;
*
   VXM = VXL1 * (COS ANG1)  + (VYL1 * (-1.) * (SIN ANG1))   ;
   VYM = VXL1 * (SIN ANG1)  + (VYL1 * (COS ANG1))           ;
   VZM =                                               VZL1 ;
FINSI ;
FINPROC VXM VYM VZM ;
**** @ACBML
DEBPROC @ACBML VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
*
**********************************************************************
* Procedure de changement de base. On passe de la base cartesienne   *
* du maillage a la base cartesienne locale de l'objet modelise. L'   *
* axe Y est dirige du point de tangence vers le centre du plasma.    *
*                 Alain MOAL (juillet-aout 1995)                     *
**********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.'CENTRE_PLASMA' ;
PTG = TAB1.'PT_TGPLASMA'   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
VECT0 = CP MOINS PTG ;
VX = COOR 1 VECT0    ;
VY = COOR 2 VECT0    ;
*
*---- calcul de l'angle de rotation dans le plan XY
SI ((VX EGA 0.) ET (VY EGA 0.)) ;
   ANG1 = 0. ;
SINON ;
   ANG1 = -1.* (ATG VX VY) ;
FINSI ;
*
SI ((VALEUR DIME) EGA 2) ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VXM * (COS ANG1)         + (VYM * (SIN ANG1));
      VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
      VZL1 = VZM ;
*     ---- Coupe 2D a Phi constant
      VXL = VZL1 ;
      VYL = VYL1 ;
      VZL = VXL1 * (-1.);
   FINSI ;
   SI (EGA IPLAN 'THETACONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXL = VXM * (COS ANG1)          + (VYM * (SIN ANG1));
      VYL = VXM * (-1.) * (SIN ANG1)  + (VYM * (COS ANG1));
      VZL = VZM ;
   FINSI ;
*
SINON ;
   VZ = COOR 3 VECT0 ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   VXM1 = VXM * (COS ANG1)          + (VYM * (SIN ANG1));
   VYM1 = VXM * (-1.) * (SIN ANG1)  + (VYM * (COS ANG1));
   VZM1 = VZM ;
*
   VX1 = VX * (COS ANG1)         + (VY * (SIN ANG1))    ;
   VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1))    ;
   VZ1 =                                             VZ ;
*
*  ---- calcul de l'angle de rotation dans le plan Y1Z1
  SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
      ANG2 = 0. ;
   SINON ;
      ANG2 = ATG VZ1 VY1 ;
   FINSI ;
*
   VXL = VXM1                                               ;
   VYL =     VYM1 * (COS ANG2)         + (VZM1 * (SIN ANG2));
   VZL =     VYM1 * (-1.) * (SIN ANG2) + (VZM1 * (COS ANG2));
*
FINSI ;
*MESS '>>>> @CBMLV' ; LIST VXL ; LIST VYL ; LIST VZL ;
FINPROC VXL VYL VZL ;

**** @ACRLM
DEBPROC  @ACRLM  XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
*
*******************************************************************
* Procedure de changement de repere. On passe du repere cartesien *
* local de l'objet modelise au repere cartesien du maillage. Le   *
* point de tangence au plasma est l'origine du repere local et    *
* l'axe Y est dirige vers le centre du plasma.                    *
*                 Alain MOAL (juillet-aout 1995)                  *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.'CENTRE_PLASMA' ;
PTG = TAB1.'PT_TGPLASMA'   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
VECT0 = CP MOINS PTG ;
VX = COOR 1 VECT0    ;
VY = COOR 2 VECT0    ;
*
*---- calcul de l'angle de rotation dans le plan XY
SI ((VX EGA 0.) ET (VY EGA 0.)) ;
   ANG1 = 0. ;
SINON ;
   ANG1 = -1.* (ATG VX VY) ;
FINSI ;
*
XPTG = COOR 1 PTG ;
YPTG = COOR 2 PTG ;
*
SI ((VALEUR DIME) EGA 2) ;
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = ZL ;
      ZL = ZL * 0.;
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
   SI (EGA IPLAN 'THETACONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
*  ---- changement d'origine du repere
   XM = XL1 + XPTG ;
   YM = YL1 + YPTG ;
   ZM = YL1 * 0. ;
SINON ;
   VZ = COOR 3 VECT0 ;
   ZPTG = COOR 3 PTG ;
*
*  ---- calcul de l'angle de rotation dans le plan Y1Z1
   VX1 = VX * (COS ANG1)         + (VY * (SIN ANG1))    ;
   VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1))    ;
   VZ1 =                                             VZ ;
*
   SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
      ANG2 = 0. ;
   SINON ;
      ANG2 = ATG VZ1 VY1 ;
   FINSI ;
*
*  ---- rotations
   XL1 = XL                                              ;
   YL1 =     YL * (COS ANG2) + (ZL * (-1.) * (SIN ANG2)) ;
   ZL1 =     YL * (SIN ANG2) + (ZL * (COS ANG2))         ;
*
   XL2 = XL1 * (COS ANG1)  + (YL1 * (-1.) * (SIN ANG1))    ;
   YL2 = XL1 * (SIN ANG1)  + (YL1 * (COS ANG1))            ;
   ZL2 =                                               ZL1 ;
*
*  ---- changement d'origine du repere
   XM = XL2 + XPTG ;
   YM = YL2 + YPTG ;
   ZM = ZL2 + ZPTG ;
FINSI ;
FINPROC XM YM ZM ;
**** @ACRML
DEBPROC  @ACRML  XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
*
*******************************************************************
* Procedure de changement de repere. On passe du repere cartesien *
* du maillage au repere cartesien local de l'objet modelise. Le   *
* point de tangence au plasma est l'origine de ce repere et l'axe *
* l'axe Y final est dirige vers le centre du plasma.              *
* en 3D l'axe x initial doit etre l'axe toroidal                  *
* en 2D cas PHICONS   l'axe Z initial est l'axe toroidal          *
* en 2D cas THETACONS l'axe x initial est l'axe toroidal          *
*                 Alain MOAL (juillet-aout 1995)                  *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.'CENTRE_PLASMA' ;
PTG = TAB1.'PT_TGPLASMA'   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> @CRMLC : TAB1.<PLAN n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
VECT0 = CP MOINS PTG ;
VX = COOR 1 VECT0    ;
VY = COOR 2 VECT0    ;
*
*---- calcul de l'angle de rotation dans le plan XY
SI ((VX EGA 0.) ET (VY EGA 0.)) ;
   ANG1 = 0. ;
SINON ;
   ANG1 = -1.* (ATG VX VY) ;
FINSI ;
*
XPTG = COOR 1 PTG ;
YPTG = COOR 2 PTG ;
*
SI ((VALEUR DIME) EGA 2) ;
*  ---- changement d'origine du repere
   XM1 = XM - XPTG ;
   YM1 = YM - YPTG ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
*
      ZL = XL ;
      XL = XL * 0.;
   FINSI;
   SI (EGA IPLAN 'THETACONS');
*     ---- Coupe 2D a Theta constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
   FINSI ;
*
SINON ;
   VZ = COOR 3 VECT0 ;
   ZPTG = COOR 3 PTG ;
*  ---- changement d'origine du repere
   XM1 = XM - XPTG ;
   YM1 = YM - YPTG ;
   ZM1 = ZM - ZPTG ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   XM2 = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1))    ;
   YM2 = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1))    ;
   ZM2 =                                               ZM1 ;
*
   VX1 = VX * (COS ANG1)         + (VY * (SIN ANG1))    ;
   VY1 = VX * (-1.) * (SIN ANG1) + (VY * (COS ANG1))    ;
   VZ1 =                                             VZ ;
*
*  ---- calcul de l'angle de rotation dans le plan Y1Z1
   SI ((VY1 EGA 0.) ET (VZ1 EGA 0.)) ;
      ANG2 = 0. ;
   SINON ;
      ANG2 = ATG VZ1 VY1 ;
   FINSI ;
*
   XL = XM2                                               ;
   YL =     YM2 * (COS ANG2)         + (ZM2 * (SIN ANG2)) ;
   ZL =     YM2 * (-1.) * (SIN ANG2) + (ZM2 * (COS ANG2)) ;
*
FINSI ;
*MESS '>>>> @CRMLC : XL' ; LIST XL ; LIST YL ; LIST ZL ;
FINPROC XL YL ZL ;

**** @AMPLI
DEBPROC @AMPLI XV*CHPOINT YV*CHPOINT ZV*CHPOINT VALDIM*ENTIER
               MAIL0*MAILLAGE ;
*
*************************************************************
* Procedure d'adaptation du facteur d'amplification utilise *
* pour visualiser un champ de vecteur sur une geometrie.    *
*                  Alain MOAL (juillet 1995)                *
*************************************************************
*
XM = COOR 1 MAIL0 ;
YM = COOR 2 MAIL0 ;
SI (VALDIM EGA 2) ;
   ZM = XM * 0. ;
SINON ;
   ZM = COOR 3 MAIL0 ;
FINSI ;
*
*---- norme du vecteur
VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
*
*---- calcul d'une longueur caracteristique du maillage
LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
*
SI (VALDIM EGA 2) ;
   LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
SINON ;
   LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
FINSI ;
*
AMPLI0 = LONGCAR / (MAXI VECNORM) / 10.;
*
FINPROC AMPLI0 ;
**** @ANADES

DEBPROC @ANADES TAB1*TABLE ;
*
*************************************************
* Procedure (inspiree de @ANALY) permettant de  *
* descendre les lignes de champ et de calculer  *
* avec une methode analytique exacte les points *
* d'intersection sur le plan de reference pour  *
* recuperer les valeurs du flux normalise.      *
*          Alain MOAL (Fevrier 2001)            *
*************************************************
*
MESS '---------------------------------> calling @ANADES';
*
*--------------- VARIABLES D'ENTREE :
S_OMBRE   = TAB1.LFLUX_EXTE ;
S_OMBRAN  = TAB1.<MAILLAGE_FN ;
CHSIGN1   = TAB1.<CHAMP_SIGNE ;
PASB2     = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
DMAX2     = TAB1.<DISTANCE_AVEC_TEST ;
NBPAS2    = TAB1.<NOMBRE_PAS_AVEC_TEST ;
PASB1     = TAB1.<LONGUEUR_PAS_SANS_TEST ;
DMAX1     = TAB1.<DISTANCE_SANS_TEST ;
NBPAS1    = TAB1.<NOMBRE_PAS_SANS_TEST ;
TOL1      = 1.e-9 ;
*------------------------------------
*
* --- PASSAGE EN TRI3 POUR LA PROCEDURE @INTSEC
si (DIME(S_OMBRAN ELEM 'TYPE') EGA 2) ;
   stri3 = elem s_ombran tri3 ;
   squa4 = elem s_ombran qua4 ;
   squtri3 = chan squa4 tri3 ;
   s_ombra2 = squtri3 et stri3 ;
sinon ;
   s_ombra2 = chan s_ombran tri3 ;
finsi ;
*
* --- CONSTRUCTION DU MAILLAGE DES POINTS A SUIVRE
MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
TABPTS1 = table ;
TABPTS1 . 1 = (chan s_ombre  poi1) poin init ;
npts = 1 ;
tablig1 = table ;

* --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
TAB1.<MAILLAGE = S_OMBRA2 ;
*AM*27/01/04 @RMXYZ TAB1 ;
@RMCOORO TAB1 ;
* --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
*AM*27/01/04 @AMNORM TAB1 ;
@RMNORM TAB1 ;
* ---- Flux normalise sur le maillage ombrant
@RMFLUN TAB1 ;

MESS ' ';
MESS 'WITHOUT TEST';
MESS 'Distance covered    :' DMAX1  ;
MESS 'Step                :' PASB1  ;
MESS 'Iterations number   :' NBPAS1 ;
MESS ' ';
MESS 'WITH TEST';
MESS 'Distance covered    :' DMAX2 ;
MESS 'Step                :' PASB2 ;
MESS 'Iterations number   :' NBPAS2 ;
MESS ' ' ;

*  --- initialisation du pas
   I1 = 0 ;
*  ---initialisation de la distance de connexion
   CHDIST  = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
*  --- initialisation du flux normalise
   CHFNORM = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
*  --- initialisation du maillage ou on va tester les intersections
   s_ombre2 = s_ombre ;
*  --- initialisation du maillage ou on va remonter les lignes
   mailcou = s_ombre2 et mailpts ;
*  ---- initialisation des distances
   LCOURAN1 = 0. ;
   LMAX1    = 0. ;
*  ---- coordonnees
   XG_OLD = COOR 1 mailcou  ;
   YG_OLD = COOR 2 mailcou  ;
   ZG_OLD = COOR 3 mailcou  ;
*
*  --- initialisation des lignes de champ remontees
   REPETER BOUPTS1 NPTS ;
      tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
   FIN BOUPTS1 ;

*--------------------------------------------------------------
*
* DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*
*--------------------------------------------------------------
*
*  ----- sans test d'interception
   PASB0 = PASB1 ;
*  increment de la distance de connexion (= PAS tant qu'il n'y a pas
*  d'intersection)

   chdist9 = manu chpo s_ombre2 1 scal pasb0 ;
   chfn9   = manu chpo s_ombre2 1 scal 0. ;
*
*  initialisation a 0 des deplacements
   DEPX0 = XG_OLD * 0. ;
   DEPY0 = YG_OLD * 0. ;
   DEPZ0 = ZG_OLD * 0. ;
   DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
   DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
   DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
   TAB1.<DEPLACEMENT = DEPX0 ET DEPY0 ET DEPZ0 ;

SI (NBPAS1 NEG 0) ;
   MESS 'WITHOUT INTERCEPTION TEST';
   REPETER BOUCLE1 NBPAS1 ;
      I1 = I1 + 1 ;
      LCOURAN1 = LCOURAN1 + PASB0 ;
      MESS ' ';
      MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;

*     ---- Appel de la procedure de descente des lignes de champ
      XG_NEW YG_NEW ZG_NEW DEP0 = @descend XG_OLD YG_OLD ZG_OLD
                                           PASB0 CHSIGN1 TAB1;
      FORM DEP0 ;
      TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;

*     ---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
      chdist = chdist + CHDIST9 ;

*     --- construction des lignes de champ remontees
*     --- Extraction des coordonnees des points a remonter
*      xmailpt2 = redu XG_NEW mailpts ;
*      ymailpt2 = redu YG_NEW mailpts ;
*      zmailpt2 = redu ZG_NEW mailpts ;
*
*     --- Construction des lignes de remontee
*      repeter boupts2 npts ;
*         xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
*         yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
*         zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
*         prem2 = xprem2 yprem2 zprem2 ;
*         tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
*      fin boupts2 ;

*     --- actualisation des champs de coordonnees pour iteration suivante
      XG_OLD = XG_NEW ;
      YG_OLD = YG_NEW ;
      ZG_OLD = ZG_NEW ;
      MENA ;
   FIN BOUCLE1 ;
FINSI ;

MESS 'WITH INTERCEPTION TEST';

PASB0 = PASB2 ;
s_ombreP = chan s_ombre poi1 ;
s_ombre2 = chan s_ombre poi1 ;
mailcou = s_ombre2 et mailpts ;

I2 = 0 ;
I3 = 0 ;
REPETER BOUCLE2 NBPAS2 ;
   I1 = I1 + 1 ;
   I3 = I3 + 1 ;
   SI (NBNO s_ombre2 > 0) ;
*     ---- si il reste des noeuds non encore intersectes
      LCOURAN1 = LCOURAN1 + PASB0 ;
      MESS ' ';
      MESS 'ITERATION : ' I1 'distance covered' LCOURAN1 ;

*     ---- Appel de la procedure de descente des lignes de champ
      XG_NEW YG_NEW ZG_NEW DEP0 = @DESCEND XG_OLD YG_OLD ZG_OLD
                                           PASB0 CHSIGN1 TAB1 ;

*     ---- test sur les eventuels noeuds interceptes
*     ---- Les CHPO sont reduits sur les points de s_ombre
*     ---- qui n'ont pas encore ete intersectes : s_ombre2
      XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
      YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
      ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;

      XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
      YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
      ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;

      XG_OLD_R = NOMC  X  XG_OLD_R 'NATU' 'DIFFUS' ;
      YG_OLD_R = NOMC  Y  YG_OLD_R 'NATU' 'DIFFUS' ;
      ZG_OLD_R = NOMC  Z  ZG_OLD_R 'NATU' 'DIFFUS' ;

      CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;

      XG_NEW_R = NOMC  X  XG_NEW_R 'NATU' 'DIFFUS' ;
      YG_NEW_R = NOMC  Y  YG_NEW_R 'NATU' 'DIFFUS' ;
      ZG_NEW_R = NOMC  Z  ZG_NEW_R 'NATU' 'DIFFUS' ;

      CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;
*
*     ---- Test d'interception
*      CHDIST9 MINTER CHFN9 DEPMP1 = @INTSEC CH_OLD CH_NEW TOL1 TAB1 ;
      CHDIST9 MINTER CHFN9 DEPMP1 = IJET CH_OLD CH_NEW TOL1 TAB1 ;

*     CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
*            ET D(M,PT_REMONTE) SINON

*     S_OMBRE2 contient les noeuds de s_ombre qui n'ont
*     pas ete intesectes
*     s_ombre0 contient les noeuds qui ont deja ete intersectes
*     minter contient les noeuds qui viennent d'etre intersectes
      s_ombre0 = diff s_ombreP s_ombre2 ;
      s_ombre2 = diff s_ombre2 MINTER ;

      TITRE 'TEST : POINTS INTERCEPTES (BLANC ET JAUNE)' ;
      TRAC ((s_ombre2 coul roug) et MINTER et
            (s_ombre0 COUL JAUNE) et TAB1.<GRILLE_B et
             TAB1.<MAILLAGE_FN) ;
*
      DEP01 = REDU DEP0 s_ombre2 ;
      DEP02 = MANU CHPO s_ombre0 3 UX 0. UY 0. UZ 0. NATURE DIFFUS ;
      SI ((NBNO MINTER) > 0) ;
         DEP0 = DEP01 ET DEP02 ET DEPMP1 ;
      SINON ;
         DEP0 = DEP01 ET DEP02 ;
      FINSI ;

      FORM DEP0 ;

*     ---- Test
*      i9 = 0 ;
*      repeter bouc01 (nbno (EXTR DEP0 'MAIL')) ;
*         i9 = i9 + 1 ;
*         list ((EXTR DEP0 'MAIL') poin i9) ;
*         list (redu CHFN9 ((EXTR DEP0 'MAIL') poin i9)) ;
*      fin bouc01 ;
*      TITRE 'TEST : NOEUDS SUPPORTS DU DEPLACEMENT';
*      TRAC (EXTR DEP0 'MAIL') ;
*     ---- Fin test

      TAB1.<DEPLACEMENT = TAB1.<DEPLACEMENT + DEP0 ;

*     ---- actualisation du maillage de descente
      mailcou = s_ombre2 et mailpts ;

      CHSIGN1 = REDU CHSIGN1 mailcou ;

      SI ((NBNO MINTER) > 0) ;
          mess (NBNO MINTER) 'intercepted points';
          LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
      FINSI ;

*     ---- Distances parcourues avant interception
      chdist = chdist + CHDIST9 ;
      chfnorm = chfnorm + chfn9 ;
      mess 'mini maxi connection distance (m)'
       (mini (prog lmax1 (mini chdist))) lmax1 ;
*      list chfnorm ;

*     --- construction des lignes de champ remontees
*     --- Extraction des coordonnees des points a remonter
*      xmailpt2 = redu XG_NEW mailpts ;
*      ymailpt2 = redu YG_NEW mailpts ;
*      zmailpt2 = redu ZG_NEW mailpts ;
*
*     --- Construction des lignes de descentes
*      repeter boupts3 npts ;
*         xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
*         yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
*         zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
*         prem2 = xprem2 yprem2 zprem2 ;
*         tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
*      fin boupts3 ;

*     --- actualisation des champs de coordonnees pour iteration suivante
      XG_OLD = redu XG_NEW mailcou;
      YG_OLD = redu YG_NEW mailcou;
      ZG_OLD = redu ZG_NEW mailcou;
      MENA ;
   sinon ;
      SI (I2 EGA 0) ;
         MESS ' ';
         MESS 'ALL POINTS ARE INTERCEPTED' ;
         MESS ' ';
         I2 = I1 ;
      FINSI ;
   finsi  ;
FIN BOUCLE2 ;

*--- Sorties dans TAB1
TAB1.<CHAMP_DISTANCE = CHDIST ;
TAB1.<LONGUEUR_CONNEXION_MAX = LMAX1 ;
TAB1.<LONGUEUR_PARCOURUE = LCOURAN1 ;

*si (exis tab1 <remontee) ;
*   tab1 . <remontee . <ligne = tablig1 ;
*finsi ;

MESS '---------------------------------> exiting @ANADES';
FINPROC chfnorm ;

**** @ANAJET

DEBPROC @ANAJET  TAB1*TABLE ;

MESS '---------------------------------> calling @ANAJET';
MESS 'METHODE ANALYTIQUE' ;
*
*--------------- VARIABLES D'ENTREE :
*

S_OMBRE   = TAB1.<S_OMBRE ;
S_OMBRAN  = TAB1.<S_OMBRANT ;
IMETHOD   = TAB1.<METHODE_REMONTEE ;
CHSIGN1   = TAB1.<CHSIGN ;


si (exis tab1 <remontee) ;
 TABPTS1 = TAB1.<REMONTEE.<POINT ;
 tablig1 = table ;
finsi ;

PASB2   = TAB1.<PAS_AVEC_TEST ;
DMAX2   = TAB1.<DIST_AVEC_TEST ;
NBPAS2  = TAB1.<NBPAS2        ;

SI (EXIS TAB1 <PAS_SANS_TEST)    ;
 PASB1  = TAB1.<PAS_SANS_TEST    ;
 DMAX1   = TAB1.<DIST_SANS_TEST ;
 NBPAS1 = TAB1.<NBPAS1           ;
FINSI                            ;


SI (EXIS TAB1 <TOLERANCE)    ;
 TOL1   = TAB1.<TOLERANCE    ;
SINON ;
 TOL1   = 1.e-9      ;
FINSI                            ;

*
* --- PASSAGE EN TRI3 POUR LA PROC @INTERC
*

LMOT = s_ombran ELEM 'TYPE' ;
ntyp = dime LMOT ;
si (ntyp ega 2) ;
 stri3 = elem s_ombran tri3 ;
 squa4 = elem s_ombran qua4 ;
 squtri3 = chan squa4 tri3 ;
 s_ombra2 = squtri3 et stri3 ;
sinon ;
 s_ombra2 = chan s_ombran tri3 ;
finsi ;


* --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
si (exis tab1 <remontee) ;
 MAILPTS = MANU POI1 TABPTS1 . 1 ;
 NPTS = DIME TABPTS1 ;
 REPETER BOUPTS1 (NPTS - 1) ;
  MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
 FIN BOUPTS1 ;
sinon ;
* RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
 MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
 TABPTS1 = table ;
 TABPTS1 . 1 = (chan s_ombre  poi1) poin init ;
 npts = 1 ;
 tablig1 = table ;
finsi ;


si (non (tab1.<reprise)) ;
* --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
* --- Remarque : ces coordonnees seront exprimees dans le repere globale
 TAB1.<MAILLAGE = S_OMBRA2 ;
*AM*27/01/04 si (non (exis tab1 <chamx1)) ;
*AM*27/01/04 @AMCOORO TAB1 ;
  @RMCOORO TAB1 ;
*AM*27/01/04 finsi ;
* --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
*AM*27/01/04  si (non (exis tab1 <cosx)) ;
  @RMNORM TAB1 ;
*AM*27/01/04  finsi ;
finsi ;


*
* --- Rappel des parametres de la procedure
*
MESS ' ';
MESS '##################################################';
MESS ' ';
MESS '>@ANAJET> procedure OMBJET, Rappel des parametres
de calcul ';
MESS ' ';

si (tab1.<reprise) ;
 mess 'Reprise d un calcul';
 mess '-------------------';
finsi ;

SI (IMETHOD EGA 1) ;
   METH = 'methode explicite des tangentes';
FINSI ;
SI (IMETHOD EGA 2) ;
   METH = 'methode moyenne des tangentes aux extremitee';
FINSI ;
SI (IMETHOD EGA 3) ;
   METH = 'methode du point milieu';
FINSI ;
SI (IMETHOD EGA 4) ;
   METH = 'methode de reprojection';
FINSI ;
MESS METH ;
MESS ' ';

SI (EXIS tab1 <PAS_SANS_TEST)  ;
 MESS 'Calcul en deux parties :';
 MESS ' ';
 MESS 'SANS TEST';
 MESS 'Distance remontee    :' DMAX1  ;
 MESS 'Pas pour la remontee :' PASB1  ;
 MESS 'Nombre d iterations  :' NBPAS1 ;
 MESS ' ';
 MESS 'AVEC TEST';
 MESS 'Distance remontee    :' DMAX2 ;
 MESS 'Pas pour la remontee :' PASB2 ;
 MESS 'Nombre d iterations  :' NBPAS2 ;
SINON ;
 MESS 'Calcul avec test systematique :';
 MESS 'Distance remontee   :' DMAX2 ;
 MESS 'Pas   de remontee   :' PASB2 ;
 MESS 'Nombre d iterations :' NBPAS2 ;
FINSI ;
MESS ' ' ;

*
*--------------------------------------------------------------
*
* INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*                   --- CAS SANS REPRISE ---
*--------------------------------------------------------------
si (non (tab1.<reprise)) ;
* --- initialisation du pas
 I1 = 0 ;
* ---initialisation de la distance de connexion
 CHDIST   = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
* --- initialisation du maillage ou on va tester les intersections
 s_ombre2 = s_ombre ;
* --- initialisation du maillage ou on va remonter les lignes
 mailcou = s_ombre2 et mailpts ;
*---- initialisation des distances
 LCOURAN1 = 0. ;
 LMAX1    = 0. ;
* ---- coordonnees dans le repere du maillage
 XM0 = COOR 1 mailcou ;
 YM0 = COOR 2 mailcou ;
 ZM0 = COOR 3 mailcou ;
*---- Coordonnees dans le repere global du tore
 XG_OLD = XM0 ;
 YG_OLD = YM0 ;
 ZG_OLD = ZM0 ;

*
* --- initialisation des lignes de champ remontees
 REPETER BOUPTS1 NPTS ;
  tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
 FIN BOUPTS1 ;

sinon ;
*
*--------------------------------------------------------------
*
* INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*                   --- CAS AVEC REPRISE ---
*--------------------------------------------------------------
* --- initialisation du pas
 I1 = tab1.<i_ombrage ;
* --- initialisation de la distance de connexion
 CHDIST   =  tab1.<chdist;
* --- initialisation du maillage ou on va tester les intersections
 s_ombre2 = tab1.<s_omb_non_inter ;
* --- initialisation du maillage ou on va remonter les lignes
 mailcou = s_ombre2 et mailpts ;


*---- initialisation des distances
 LCOURAN1 = maxi chdist ;
 LMAX1    = tab1.<CONNEXION_MAX ;

*---- Coordonnees dans le repere global du tore
 XG_OLD = exco X tab1.<CHCOOR0 ;
 YG_OLD = exco Y tab1.<CHCOOR0 ;
 ZG_OLD = exco Z tab1.<CHCOOR0 ;
*

* --- initialisation des lignes de champ remontees
 si (exis tab1 <remontee) ;
  tablig1 = tab1.<remontee.<ligne ;
 sinon ;
  tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
 finsi ;

finsi ;

*--------------------------------------------------------------
*
* DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*
*--------------------------------------------------------------
*
MESS ' ';
MESS '##################################################';
MESS ' ';

SI (EXIS TAB1 <DIST_SANS_TEST) ;

* ------------------ Boucle 1 on remonte sans test -------------------
 PASB0 = PASB1 ;
* increment de la distance de connexion (= PAS tant qu'il n'y a pas
* d'intersection)
 chdist9 = manu chpo s_ombre2 1 scal pasb0 ;

*
*  initialisation a 0 des deplacements
   DEPX0 = XG_OLD * 0. ;
   DEPY0 = YG_OLD * 0. ;
   DEPZ0 = ZG_OLD * 0. ;
   DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
   DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
   DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
   TAB1.<DEPLACE = DEPX0 ET DEPY0 ET DEPZ0 ;

 MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
 REPETER BOUCLE1 NBPAS1 ;
  I1 = I1 + 1 ;
  LCOURAN1 = LCOURAN1 + PASB0 ;
  MESS ' ';
  MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;

* ---- Appel de la procedure de remontee des lignes de champ
  XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD
                                  PASB0 CHSIGN1 TAB1 ;
  FORM DEP0 ;
  TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  TITRE 'SANS TEST, ITERATION : 'I1 ;
  TRAC ((s_ombre2 coul roug) ET TAB1.<GRILLE_B ET
        TAB1.<S_OMBRANT)  ;

*---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  chdist = chdist + CHDIST9 ;


*-----------------------------------------------------------------
*--- construction des lignes de champ remontees
* --- Extraction des coordonnees des points a remonter
  xmailpt1 = redu XG_NEW mailpts ;
  ymailpt1 = redu YG_NEW mailpts ;
  zmailpt1 = redu ZG_NEW mailpts ;

* --- Calcul des coordonnees des points a remonter dans le repere du maillage
  xmailpt2 = xmailpt1 ;
  ymailpt2 = ymailpt1 ;
  zmailpt2 = zmailpt1 ;

*
* --- Construction des lignes de remontee
  repeter boupts2 npts ;
   xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
   yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
   zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
   prem2 = xprem2 yprem2 zprem2 ;
   tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  fin boupts2 ;
**-----------------------------------------------------------------


* --- actualisation des champs de coordonnees pour iteration suivante

  XG_OLD = XG_NEW ;
  YG_OLD = YG_NEW ;
  ZG_OLD = ZG_NEW ;

  MENA ;

 FIN BOUCLE1 ;
* ------------------------ Fin de la boucle 1 ------------------------
finsi ;


MESS ' ';
MESS '##################################################';
MESS ' ';

MESS 'CALCUL AVEC TEST D INTERSECTION';

* ------------------ Boucle 2 on remonte avec test -------------------
PASB0 = PASB2 ;
si (non (tab1.<reprise)) ;
 s_ombre2 = chan s_ombre poi1 ;
 mailcou = s_ombre2 et mailpts ;
finsi ;
REPETER BOUCLE2 NBPAS2 ;

 I1 = I1 + 1 ;
 LCOURAN1 = LCOURAN1 + PASB0 ;
 MESS ' ';
 MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;

* ---- Appel de la procedure de remonter des lignes de champ
 XG_NEW YG_NEW ZG_NEW DEP0 = @remojet XG_OLD YG_OLD ZG_OLD
                                 PASB0 CHSIGN1 TAB1 ;
*---- ------test sur les eventuels noeuds interceptes -----------
*---- seulement s'il reste des noeuds non encore intersectes ----
 si (nbno s_ombre2 > 0.) ;

* --- Les CHPO sont reduits sur les points de s_ombre
* --- qui n'ont pas encore ete intersectes : s_ombre2

  XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;

  XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;


  XG_OLD_R = NOMC  X  XG_OLD_R 'NATU' 'DIFFUS' ;
  YG_OLD_R = NOMC  Y  YG_OLD_R 'NATU' 'DIFFUS' ;
  ZG_OLD_R = NOMC  Z  ZG_OLD_R 'NATU' 'DIFFUS' ;

  CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;


  XG_NEW_R = NOMC  X  XG_NEW_R 'NATU' 'DIFFUS' ;
  YG_NEW_R = NOMC  Y  YG_NEW_R 'NATU' 'DIFFUS' ;
  ZG_NEW_R = NOMC  Z  ZG_NEW_R 'NATU' 'DIFFUS' ;

  CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;

*
* --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
*
*  CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
   CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;

* CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
*            ET D(M,PT_REMONTE) SINON


* S_OMBRE2 contient les noeuds  de s_ombre qui n'ont
* pas ete intesectes.
  s_ombre2 = diff s_ombre2 MINTER ;

* actualisation du maillage de remontee
  mailcou = s_ombre2 et mailpts ;

  CHSIGN1 = REDU CHSIGN1 mailcou ;

  SI ((NBNO MINTER) > 0) ;
   mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
   LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  FINSI ;

* ---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  chdist = chdist + CHDIST9 ;
  mess 'mini maxi dist connection en m'
  (mini (prog lmax1 (mini chdist))) lmax1 ;


 finsi  ;
* ------------------ fin du test d'interception ------------------



*-----------------------------------------------------------------
*--- construction des lignes de champ remontees
*--- Extraction des coordonnees des points a remonter
 xmailpt1 = redu XG_NEW mailpts ;
 ymailpt1 = redu YG_NEW mailpts ;
 zmailpt1 = redu ZG_NEW mailpts ;

*--- Calcul des coordonnees des points a remonter dans le repere du maillage
 xmailpt2 = xmailpt1 ;
 ymailpt2 = ymailpt1 ;
 zmailpt2 = zmailpt1 ;

*--- Construction des lignes de remontee
 repeter boupts3 npts ;
  xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  prem2 = xprem2 yprem2 zprem2 ;
  tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
 fin boupts3 ;
*-----------------------------------------------------------------



* --- actualisation des champs de coordonnees pour iteration suivante

 XG_OLD = redu XG_NEW mailcou;
 YG_OLD = redu YG_NEW mailcou;
 ZG_OLD = redu ZG_NEW mailcou;

 MENA ;
 FORM DEP0 ;
 TAB1.<DEPLACE = TAB1.<DEPLACE + DEP0 ;
  TITRE 'AVEC TEST, ITERATION : 'I1 ;
  TRAC ((s_ombre2 coul roug) ET MINTER ET
        TAB1.<GRILLE_B ET TAB1.<S_OMBRANT)  ;

FIN BOUCLE2 ;
* --------------------- Fin de la boucle 2 ----------------------


*--- Sorties dans TAB1

TAB1.<CHDIST =  CHDIST ;
TAB1.<CONNEXION_MAX = LMAX1 ;
TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;

si (exis tab1 <remontee) ;
 tab1 . <remontee . <ligne = tablig1 ;
finsi ;

*Sauvegardes pour reprise eventuelle
XG_OLD = nomc X XG_OLD nature discret ;
YG_OLD = nomc Y YG_OLD nature discret ;
ZG_OLD = nomc Z ZG_OLD nature discret ;
tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
tab1.<s_omb_non_inter = s_ombre2 ;
tab1.<i_ombrage = i1 ;

MESS '---------------------------------> exiting @ANAJET';
FINPROC ;

**** @ANALY

DEBPROC @ANALY  TAB1*TABLE ;

MESS '---------------------------------> calling @ANALY';
MESS 'METHODE ANALYTIQUE' ;
*
*--------------- VARIABLES D'ENTREE :
*

S_OMBRE   = TAB1.<S_OMBRE ;
S_OMBRAN  = TAB1.<S_OMBRANT ;
IMETHOD   = TAB1.<METHODE_REMONTEE ;
CHSIGN1   = TAB1.<CHSIGN ;

TYPCAL  = TAB1.<TYPE_CALCUL       ;
RP      = TAB1.<RP ;
RHO0    = TAB1.<RHO0 ;
RR      = TAB1.<RR ;
HP      = TAB1.<HP ;
EPS0    = TAB1.<EPS ;
COEFA   = TAB1.<COEFA ;
COEFB   = TAB1.<COEFB ;
COEFC   = TAB1.<COEFC ;
NBOB    = TAB1.<NBOB  ;

si (exis tab1 <remontee) ;
 TABPTS1 = TAB1.<REMONTEE.<POINT ;
 tablig1 = table ;
finsi ;

PASB2   = TAB1.<PAS_AVEC_TEST ;
DMAX2   = TAB1.<DIST_AVEC_TEST ;
NBPAS2  = TAB1.<NBPAS2        ;

SI (EXIS TAB1 <PAS_SANS_TEST)    ;
 PASB1  = TAB1.<PAS_SANS_TEST    ;
 DMAX1   = TAB1.<DIST_SANS_TEST ;
 NBPAS1 = TAB1.<NBPAS1           ;
FINSI                            ;


SI (EXIS TAB1 <TOLERANCE)    ;
 TOL1   = TAB1.<TOLERANCE    ;
SINON ;
 TOL1   = 1.e-9      ;
FINSI                            ;

*
* --- PASSAGE EN TRI3 POUR LA PROC @INTERC
*

LMOT = s_ombran ELEM 'TYPE' ;
ntyp = dime LMOT ;
si (ntyp ega 2) ;
 stri3 = elem s_ombran tri3 ;
 squa4 = elem s_ombran qua4 ;
 squtri3 = chan squa4 tri3 ;
 s_ombra2 = squtri3 et stri3 ;
sinon ;
 s_ombra2 = chan s_ombran tri3 ;
finsi ;

*
* ---
*
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;


* --- CONSTRUCTION DU MAILLAGE DES POINTS A REMONTER
si (exis tab1 <remontee) ;
 MAILPTS = MANU POI1 TABPTS1 . 1 ;
 NPTS = DIME TABPTS1 ;
 REPETER BOUPTS1 (NPTS - 1) ;
  MAILPTS = MAILPTS ET TABPTS1 . (&BOUPTS1 + 1) ;
 FIN BOUPTS1 ;
sinon ;
* RM 15/06/2000 MAILPTS = MANU POI1 (s_ombre poin init) ;
 MAILPTS = MANU POI1 ((chan s_ombre poi1) poin init) ;
 TABPTS1 = table ;
 TABPTS1 . 1 = (chan s_ombre  poi1) poin init ;
 npts = 1 ;
 tablig1 = table ;
finsi ;


si (non (tab1.<reprise)) ;
* --- CREATION DES 3 CHMELEM DE COORDONNEES AUX ELEMENTS
* --- Remarque : ces coordonnees seront exprimees dans le repere globale
 TAB1.<MAILLAGE = S_OMBRA2 ;
 si (non (exis tab1 <chamx1)) ;
  @RMCOORO TAB1 ;
 finsi ;
* --- CALCUL DES NORMALES AUX ELEMENTS SUR LE MAILLAGE OMBRANT
 si (non (exis tab1 <cosx)) ;
  @RMNORM TAB1 ;
 finsi ;
finsi ;


*
* --- Rappel des parametres de la procedure
*
MESS ' ';
MESS '##################################################';
MESS ' ';
MESS '>@ANALY> procedure OMBRAGE, Rappel des parametres
de calcul ';
MESS ' ';

si (tab1.<reprise) ;
 mess 'Reprise d un calcul';
 mess '-------------------';
finsi ;

SI (IMETHOD EGA 1) ;
   METH = 'methode explicite des tangentes';
FINSI ;
SI (IMETHOD EGA 2) ;
   METH = 'methode moyenne des tangentes aux extremitee';
FINSI ;
SI (IMETHOD EGA 3) ;
   METH = 'methode du point milieu';
FINSI ;
SI (IMETHOD EGA 4) ;
   METH = 'methode de reprojection';
FINSI ;
MESS METH ;
MESS ' ';

SI (EXIS tab1 <PAS_SANS_TEST)  ;
 MESS 'Calcul en deux parties :';
 MESS ' ';
 MESS 'SANS TEST';
 MESS 'Distance remontee    :' DMAX1  ;
 MESS 'Pas pour la remontee :' PASB1  ;
 MESS 'Nombre d iterations  :' NBPAS1 ;
 MESS ' ';
 MESS 'AVEC TEST';
 MESS 'Distance remontee    :' DMAX2 ;
 MESS 'Pas pour la remontee :' PASB2 ;
 MESS 'Nombre d iterations  :' NBPAS2 ;
SINON ;
 MESS 'Calcul avec test systematique :';
 MESS 'Distance remontee   :' DMAX2 ;
 MESS 'Pas   de remontee   :' PASB2 ;
 MESS 'Nombre d iterations :' NBPAS2 ;
FINSI ;
MESS ' ' ;

SI ISHIFT ;
 MESS 'Calcul avec shift de Safranov' ;
SINON ;
 MESS 'Calcul sans shift de Safranov';
FINSI ;

SI IRIPPLE ;
 MESS 'Calcul avec ripple du champ toroidal' ;
SINON ;
 MESS 'Calcul sans ripple du champ toroidal' ;
FINSI ;


*
*--------------------------------------------------------------
*
* INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*                   --- CAS SANS REPRISE ---
*--------------------------------------------------------------
si (non (tab1.<reprise)) ;
* --- initialisation du pas
 I1 = 0 ;
* ---initialisation de la distance de connexion
 CHDIST   = manu chpo S_OMBRE 1 'SCAL' 0. nature discret ;
* --- initialisation du maillage ou on va tester les intersections
 s_ombre2 = s_ombre ;
* --- initialisation du maillage ou on va remonter les lignes
 mailcou = s_ombre2 et mailpts ;
*---- initialisation des distances
 LCOURAN1 = 0. ;
 LMAX1    = 0. ;
* ---- coordonnees dans le repere du maillage
 XM0 = COOR 1 mailcou ;
 YM0 = COOR 2 mailcou ;
 ZM0 = COOR 3 mailcou ;
*---- Coordonnees dans le repere global du tore
 XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
*
* --- initialisation des lignes de champ remontees
 REPETER BOUPTS1 NPTS ;
  tablig1 . &BOUPTS1 = TABPTS1 . &BOUPTS1 ;
 FIN BOUPTS1 ;

sinon ;
*
*--------------------------------------------------------------
*
* INITIALISATION DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*                   --- CAS AVEC REPRISE ---
*--------------------------------------------------------------
* --- initialisation du pas
 I1 = tab1.<i_ombrage ;
* --- initialisation de la distance de connexion
 CHDIST   =  tab1.<chdist;
* --- initialisation du maillage ou on va tester les intersections
 s_ombre2 = tab1.<s_omb_non_inter ;
* --- initialisation du maillage ou on va remonter les lignes
 mailcou = s_ombre2 et mailpts ;


*---- initialisation des distances
 LCOURAN1 = maxi chdist ;
 LMAX1    = tab1.<CONNEXION_MAX ;

*---- Coordonnees dans le repere global du tore
 XG_OLD = exco X tab1.<CHCOOR0 ;
 YG_OLD = exco Y tab1.<CHCOOR0 ;
 ZG_OLD = exco Z tab1.<CHCOOR0 ;
*

* --- initialisation des lignes de champ remontees
 si (exis tab1 <remontee) ;
  tablig1 = tab1.<remontee.<ligne ;
 sinon ;
  tablig1 . 1 = (TABPTS1 . 1) d 1 (TABPTS1.1 plus (0. 0. 0.));
 finsi ;

finsi ;

*--------------------------------------------------------------
*
* DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*
*--------------------------------------------------------------
*
MESS ' ';
MESS '##################################################';
MESS ' ';

SI (EXIS TAB1 <DIST_SANS_TEST) ;

* ------------------ Boucle 1 on remonte sans test -------------------
 PASB0 = PASB1 ;
* increment de la distance de connexion (= PAS tant qu'il n'y a pas
* d'intersection)
 chdist9 = manu chpo s_ombre2 1 scal pasb0 ;

 MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
 REPETER BOUCLE1 NBPAS1 ;
  I1 = I1 + 1 ;
  LCOURAN1 = LCOURAN1 + PASB0 ;
  MESS ' ';
  MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;

* ---- Appel de la procedure de remontee des lignes de champ
  XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD
                                  PASB0 CHSIGN1 TAB1 ;

*---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  chdist = chdist + CHDIST9 ;


*-----------------------------------------------------------------
*--- construction des lignes de champ remontees
* --- Extraction des coordonnees des points a remonter
  xmailpt1 = redu XG_NEW mailpts ;
  ymailpt1 = redu YG_NEW mailpts ;
  zmailpt1 = redu ZG_NEW mailpts ;

* --- Calcul des coordonnees des points a remonter dans le repere du maillage
  xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;
*
* --- Construction des lignes de remontee
  repeter boupts2 npts ;
   xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts2) ;
   yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts2) ;
   zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts2) ;
   prem2 = xprem2 yprem2 zprem2 ;
   tablig1.&boupts2 = (tablig1 . &boupts2) d 1 prem2 ;
  fin boupts2 ;
**-----------------------------------------------------------------


* --- actualisation des champs de coordonnees pour iteration suivante

  XG_OLD = XG_NEW ;
  YG_OLD = YG_NEW ;
  ZG_OLD = ZG_NEW ;

  MENA ;

 FIN BOUCLE1 ;
* ------------------------ Fin de la boucle 1 ------------------------
finsi ;


MESS ' ';
MESS '##################################################';
MESS ' ';

MESS 'CALCUL AVEC TEST D INTERSECTION';

* ------------------ Boucle 2 on remonte avec test -------------------
PASB0 = PASB2 ;
si (non (tab1.<reprise)) ;
 s_ombre2 = chan s_ombre poi1 ;
 mailcou = s_ombre2 et mailpts ;
finsi ;
REPETER BOUCLE2 NBPAS2 ;

 I1 = I1 + 1 ;
 LCOURAN1 = LCOURAN1 + PASB0 ;
 MESS ' ';
 MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;

* ---- Appel de la procedure de remonter des lignes de champ
 XG_NEW YG_NEW ZG_NEW = @remonte XG_OLD YG_OLD ZG_OLD
                                 PASB0 CHSIGN1 TAB1 ;
*---- ------test sur les eventuels noeuds interceptes -----------
*---- seulement s'il reste des noeuds non encore intersectes ----
 si (nbno s_ombre2 > 0.) ;

* --- Les CHPO sont reduits sur les points de s_ombre
* --- qui n'ont pas encore ete intersectes : s_ombre2

  XG_OLD_R = REDU XG_OLD S_OMBRE2 ;
  YG_OLD_R = REDU YG_OLD S_OMBRE2 ;
  ZG_OLD_R = REDU ZG_OLD S_OMBRE2 ;

  XG_NEW_R = REDU XG_NEW S_OMBRE2 ;
  YG_NEW_R = REDU YG_NEW S_OMBRE2 ;
  ZG_NEW_R = REDU ZG_NEW S_OMBRE2 ;


  XG_OLD_R = NOMC  X  XG_OLD_R 'NATU' 'DIFFUS' ;
  YG_OLD_R = NOMC  Y  YG_OLD_R 'NATU' 'DIFFUS' ;
  ZG_OLD_R = NOMC  Z  ZG_OLD_R 'NATU' 'DIFFUS' ;

  CH_OLD = XG_OLD_R ET YG_OLD_R ET ZG_OLD_R ;


  XG_NEW_R = NOMC  X  XG_NEW_R 'NATU' 'DIFFUS' ;
  YG_NEW_R = NOMC  Y  YG_NEW_R 'NATU' 'DIFFUS' ;
  ZG_NEW_R = NOMC  Z  ZG_NEW_R 'NATU' 'DIFFUS' ;

  CH_NEW = XG_NEW_R ET YG_NEW_R ET ZG_NEW_R ;

*
* --- APPEL DE LA PROCEDURE DE CALCUL DES NOEUDS INTERSECTES
*
*  CHDIST9 MINTER = @INTERC CH_OLD CH_NEW TOL1 TAB1 ;
  CHDIST9 MINTER = ITRC CH_OLD CH_NEW TOL1 TAB1 ;

* CHDIST9 = CHPO CONTENANT PAS POUR LES NOEUDS INTERSECTES
*            ET D(M,PT_REMONTE) SINON


* S_OMBRE2 contient les noeuds  de s_ombre qui n'ont
* pas ete intesectes.
  s_ombre2 = diff s_ombre2 MINTER ;

* actualisation du maillage de remontee
  mailcou = s_ombre2 et mailpts ;

  CHSIGN1 = REDU CHSIGN1 mailcou ;

  SI ((NBNO MINTER) > 0) ;
   mess 'nombre de noeuds intersectes ' (NBNO MINTER) ;
   LMAX1 = LCOURAN1 - pasb0 + (mini CHDIST9) ;
  FINSI ;

* ---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  chdist = chdist + CHDIST9 ;
  mess 'mini maxi dist connection en m'
  (mini (prog lmax1 (mini chdist))) lmax1 ;


 finsi  ;
* ------------------ fin du test d'interception ------------------



*-----------------------------------------------------------------
*--- construction des lignes de champ remontees
*--- Extraction des coordonnees des points a remonter
 xmailpt1 = redu XG_NEW mailpts ;
 ymailpt1 = redu YG_NEW mailpts ;
 zmailpt1 = redu ZG_NEW mailpts ;

*--- Calcul des coordonnees des points a remonter dans le repere du maillage
 xmailpt2 ymailpt2 zmailpt2 = @crgmc xmailpt1 ymailpt1 zmailpt1 tab1 ;

*--- Construction des lignes de remontee
 repeter boupts3 npts ;
  xprem2 = extr xmailpt2 SCAL (tabpts1 . &boupts3) ;
  yprem2 = extr ymailpt2 SCAL (tabpts1 . &boupts3) ;
  zprem2 = extr zmailpt2 SCAL (tabpts1 . &boupts3) ;
  prem2 = xprem2 yprem2 zprem2 ;
  tablig1 . &boupts3 = (tablig1 . &boupts3) d 1 prem2 ;
 fin boupts3 ;
*-----------------------------------------------------------------



* --- actualisation des champs de coordonnees pour iteration suivante

 XG_OLD = redu XG_NEW mailcou;
 YG_OLD = redu YG_NEW mailcou;
 ZG_OLD = redu ZG_NEW mailcou;

 MENA ;

FIN BOUCLE2 ;
* --------------------- Fin de la boucle 2 ----------------------


*--- Sorties dans TAB1

TAB1.<CHDIST =  CHDIST ;
TAB1.<CONNEXION_MAX = LMAX1 ;
TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;

si (exis tab1 <remontee) ;
 tab1 . <remontee . <ligne = tablig1 ;
finsi ;

*Sauvegardes pour reprise eventuelle
XG_OLD = nomc X XG_OLD nature discret ;
YG_OLD = nomc Y YG_OLD nature discret ;
ZG_OLD = nomc Z ZG_OLD nature discret ;
tab1.<CHCOOR0 = (XG_OLD et YG_OLD et ZG_OLD) ;
tab1.<s_omb_non_inter = s_ombre2 ;
tab1.<i_ombrage = i1 ;

MESS '---------------------------------> exiting @ANALY';
FINPROC ;

**** @ARANGU
DEBPROC @ARANGU T1*FLOTTANT V1*FLOTTANT E1*FLOTTANT ;
*-------------------------------------------------------------------*
* R. Mitteau
* Fatigue du cuivre OFHC
*
* D'apres la publi
*
*
* High Temperature Torsional Low Cycle Fatigue of OFHC Copper
* Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
* Marmara Research Institute...
*
* in Z. Metallkunde
* T1 temperature en degres K
* V1 vitesse de deformation en s-1
* E1 Deformation en .
*
*
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5          6        7
*-------------------------------------------------------------------*
MESS '-----------------------------------------------> calling @ARANGU';
*
* --- donnees
*
* Temperature de la matiere en Kelvin
TLIEU1   = T1 ;
* Variation equivalente de la deformation au lieu considere
EPSETOI1 = E1 ;
* Vitesse de  deformation
VDEF1 = V1 ;

*
* --- Calcul du alpha de la loi de Mansson-Coffin
*
EVALPH1 = EVOL MANU 'T'    (PROG 293 438 588 668 )
                    'ALPH' (PROG .67 .71 .63 .50 );
EVALPH2 = EVOL MANU 'T'    (PROG 293 438 588 668 )
                    'ALPH' (PROG .64 .79 .69 .50 );

VALALPH1 = IPOE EVALPH1 TLIEU1 FIXE;
VALALPH2 = IPOE EVALPH2 TLIEU1 FIXE;

EVALPH3 =  EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 )
                     'ALPH' (PROG VALALPH1  VALALPH2);

ALPHA1 = IPOE VDEF1 EVALPH3 LINE;



*
* --- Calcul du C de la loi de Mansson-Coffin
*
EVC1 = EVOL MANU 'T' (PROG 293  438 588  668 )
                 'C' (PROG 5.77 6.3 3.56 0.72 );
EVC2 = EVOL MANU 'T' (PROG 293  438   588   668 )
                 'C' (PROG 5.03 12.25 7.01 1.09 );

VALC1 = IPOE EVC1 TLIEU1 FIXE;
VALC2 = IPOE EVC2 TLIEU1 FIXE;

EVC3 =  EVOL MANU 'VDEF' (PROG 1.81E-3 9.05E-3 )
                     'C' (PROG VALC1  VALC2);

CA1 = IPOE VDEF1 EVC3  LINE;


*
* --- Calcul du nombre de cycles
*

NCYCLES1 = (CA1/EPSETOI1) ** (1. / ALPHA1) ;
NCYCLES2 = ENTI (NCYCLES1 + 1);
MESS '>@ARANGU> Temperature                     [K]     : '  T1  ;
MESS '>@ARANGU> Deformation speed               [S-1]   : '  V1  ;
MESS '>@ARANGU> Rupture according to Aran-Gucer [cycles]: ' NCYCLES2 ;

MESS '-----------------------------------------------> exiting @ARANGU';
FINPROC NCYCLES1;

**** @BOWRI72
DEBPROC @BOWRI72 TAB_1*TABLE  ;
*
*
* CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE BOWRING
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
*
* --- entrees
*
INIVEAU1 = TAB_1.'NIVEAU' ;
D_DIAM1  = TAB_1.'D_DIAM' ;
L_LONG1  = TAB_1.'L_HEATED' ;
P_PRES1  = TAB_1.'P_IN' ;
V_VITE1  = TAB_1.'V_IN' ;
T_TEMP1  = TAB_1.'T_IN'  ;
TEST1 = FAUX ;
SI (EXISTE TAB1 ANNULE_D_DEF);
 SI TAB1.ANNULE_D_DEF ;
  TEST1 = VRAI;
 FINSI ;
FINSI ;

*
* --- racine
*
SI (INIVEAU1 >EG 2 ) ;
MESS '---------------------------------> calling @BOWRI72';
FINSI ;
PI = 3.14159;
 LOGI_1 = EXISTE TAB_1 EPTSAT;
 LOGI_2 = EXISTE TAB_1 ETHFG;
 LOGI_3 = EXISTE TAB_1 ETRHOF;
 LOGI_4 = EXISTE TAB_1 ETCPF;
 SI (NON (LOGI_1 ET LOGI_2 ET LOGI_3 ET LOGI_4));
  @TABEAU TAB_1 ;
 FINSI ;

*
* --- Test du domaine de definition des entrees
*
G_VITE1 = V_VITE1 * (@IPOE TAB_1.ETRHOF T_TEMP1);

SI TEST1 ;
* - test sur la vitesse de l'eau
SI ((G_VITE1  < 136.) OU ( G_VITE1 > 18600.))                    ;
 MESS 'Vitesse massique : ' G_VITE1;
 ERRE '@BOWRING -> Vitesse massique hors [136. , 18600.] (Kg/M2/S)';
FINSI                                                                 ;

* - test sur le diametre
SI ((D_DIAM1 < 2.E-3) OU (D_DIAM1 > 450.E-3))                       ;
 MESS 'Diametre : '  D_DIAM1;
 ERRE '@BOWRING -> Diametre hors [0.002 0.45] (M)'             ;
FINSI                                                                 ;

* - test sur la Pression
SI ((P_PRES1 < 1.E5) OU (P_PRES1 > 200.E5))                      ;
 MESS 'Pression : ' P_PRES1;
 ERRE '@BOWRING -> Pression hors de [1.E5, 200.E5] (Pa) '       ;
FINSI                                                                 ;

* - test sur la longueur chauffee
SI ((L_LONG1 < 0.15) OU (L_LONG1 > 3.7))                    ;
 MESS 'Longueur : ' L_LONG1;
 ERRE '@BOWRING --> Longueur hors de [0.15,3.7](M) '  ;
FINSI                                                                 ;

* Fin des tests sur les entrees de @BOWRI72
FINSI ;

T_SAT = @IPOE TAB_1.EPTSAT P_PRES1 ;

P1 = P_PRES1 / 6900000. ;
SI (INIVEAU1 >EG 2) ;
 MESS 'P_PRIME : ' P1 ;
FINSI ;

SI (P1 <EG 1.) ;
 F1 = (((P1 ** 18.942) * (EXP (20.8 * (1. - P1)))) + 0.917) / 1.917;
 F2 = (F1 * 1.309)/(((P1 ** 1.316)*(EXP(2.444*(1. - P1)))) + 0.309);
 F3 = (((P1 ** 17.023)*(EXP(16.658*(1. - P1)))) + 0.667)/1.667;
 F4 = F3 * (P1 ** 1.649) ;
SINON ;
 F1 = (P1 ** (-0.368))*(EXP(0.648*(1. - P1)));
 F2 = (P1 ** (-0.448))*(EXP(0.245*(1. - P1)));
 F3 = P1 ** 0.219;
 F4 = F3 * (P1 ** 1.649) ;
FINSI ;

SI (INIVEAU1 >EG 2) ;
 MESS 'F1 : ' F1 ;
 MESS 'F2 : ' F2 ;
 MESS 'F3 : ' F3 ;
 MESS 'F4 : ' F4 ;
FINSI ;


L_VAP = @IPOE TAB_1.ETHFG T_TEMP1 ;
CP__1 = @IPOE TAB_1.ETCPF T_TEMP1 ;

S_SAT = CP__1 * (T_SAT - T_TEMP1) ;

SI (INIVEAU1 >EG 2) ;
 MESS 'L_VAP : ' L_VAP ;
 MESS 'CP__1 : ' CP__1 ;
 MESS 'S_SAT : ' S_SAT ;
FINSI ;

A__1 = 0.5793 * L_VAP * D_DIAM1 * G_VITE1 * F1 /
     (1. + (0.0143 * F2 * (D_DIAM1 ** .5) * G_VITE1 )) ;

B__1 = .25 * D_DIAM1 * G_VITE1 ;

C__1 = 0.077 * D_DIAM1 * G_VITE1 * F3 /
     (1. + (0.347 * F4 * ((G_VITE1/1356.) ** (2. - (.5 * P1))))) ;

SI (INIVEAU1 >EG 5) ;
 MESS 'A : ' A__1 ;
 MESS 'B : ' B__1 ;
 MESS 'C : ' C__1 ;
FINSI ;

QCHFW = (A__1 + (B__1 * S_SAT)) / (C__1 + L_LONG1) ;

G1 = G_VITE1 * PI * D_DIAM1 * D_DIAM1 / 4. ;
*
* --- sortie de la procedure
*

SI ( INIVEAU1 >EG 1 )                                                ;
 MESS '>>@BOWRI72>>  TUBE DIAMETER           (M)     : ' D_DIAM1    ;
 MESS '>>@BOWRI72>>  TUBE LENGHT             (M)     : ' L_LONG1    ;
 MESS '>>@BOWRI72>>  MASS FLOW VELOCITY   (KG/S/M2)  : ' G_VITE1;
 MESS '>>@BOWRI72>>  INLET MASS FLOW RATE  (KG/S)    : ' G1      ;
 MESS '>>@BOWRI72>>  VELOCITY               (M/S)    : ' V_VITE1      ;
 MESS '>>@BOWRI72>>  FLUID INLET TEMPERATURE (C)     : ' T_TEMP1     ;
 MESS '>>@BOWRI72>>  FLUID INLET PRESSURE    (PA)    : ' P_PRES1   ;
 MESS '>>@BOWRI72>>  WATER SATURATION TEMPERATURE(C) : ' T_SAT    ;
 MESS '>>@BOWRI72>>  WALL CRITICAL HEAT FLUX  (W/m2) : ' QCHFW    ;
FINSI                                                               ;

SI (INIVEAU1 >EG 2 ) ;
 MESS '---------------------------------> Sortie  de  @BOWRI72';
FINSI ;
*
* --- sorties
*
TAB1.CHF = QCHFW ;

FINPROC         ;


debproc @calcflu mod1*mmodel cht1*chpoint mat1*chpoint ;

gradt1 = grad cht1 mod1 ;
flux1 = mat1 * gradt1 ;

finproc flux1 ;

**** @CALHCON
DEBPROC  @CALHCON TAB_1*TABLE ;

*
* !!! R. MITTEAU !!! attention, procedure standard
*
* un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
* pour les mises a jour
*
*-------------------------------------------------------------------*
*                                                                   *
*    COEFFICIENT D ECHANGE TENANT COMPTE                            *
*    DE L EBULLITION SOUS SATUREE                                   *
*                                                                   *
*-------------------------------------------------------------------*
*
DIAM     = TAB_1 . D_MAQUETTE    ;
TTAPE    = TAB_1 . T_TAPE        ;
YTW1     = TAB_1 . TWIST_RATIO   ;
V1       = TAB_1 . V_LOCAL       ;
*js 20/4/95 je change T_MOY en t_local ????
T_LOC1   = TAB_1 . 'T_LOCAL'     ;
NIVEAU   = TAB_1.'NIVEAU'        ;
P_LOCAL1 = TAB_1.'P_LOCAL'       ;
L1TRAC    = TAB_1.'TRAC_GRAPHE'  ;
*
SI (NIVEAU >EG 4) ;
 MESS '-----------------------------------> calling @CALHCON '  ;
FINSI           ;
*
*
PI  = 3.14159               ;
*S1  = PI * DIAM * DIAM / 4. ;
SI ( NON ( EXISTE TAB_1 HYPERVAP ) )                             ;
 TAB_1.HYPERVAP = FAUX                                           ;
FINSI                                                            ;
SI ( ( YTW1 EGA 0. 1.E-6 ) ET ( EGA TAB_1.HYPERVAP FAUX ) )    ;
 S1  = PI * DIAM * DIAM / 4. ;
 TAB_1.DH = DIAM  ;
 FACV =  1. ;
 FACF =  1. ;
FINSI       ;
SI ( NON ( EXISTE TAB_1 HELI_WIRE ) )                            ;
 TAB_1.HELI_WIRE = FAUX                                          ;
FINSI                                                            ;
SI ( ( YTW1 EGA 0. 1.E-6 )  ET  ( EGA TAB_1.HELI_WIRE VRAI )
    ET ( EGA TAB_1.HYPERVAP FAUX ) ) ;
 S1 = PI * DIAM * DIAM / 4.                                      ;
 SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4.                      ;
 P1 = PI * DIAM                                                  ;
 PM = PI * TAB_1.WIRE_D                                          ;
 TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM )                       ;
 PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE )                           ;
 FACV =  ( 1. + ( PIS2Y ** 2 ) ) ** 0.5                          ;
* FACV =  1.                                                      ;
 FACF =  1.                                                      ;
FINSI                                                            ;
*
SI ( ( YTW1 EGA 0. 1.E-6 )  ET  ( EGA TAB_1.HYPERVAP VRAI ) )    ;
 SM =  ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) +
      ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) )              ;
 PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) +
      ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) +
        TAB_1 . LFIN                                             ;
 TAB_1.DH = 4. * SM / PM                                         ;
 FACV =  1.                                                      ;
* FACF =  2.25                                                      ;
* modif 261099 calcul du rapport Strue/Sapparent
* N CURT
SI (TAB_1.HFIN >  0. ) ;


 S_E1 =  ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))*
 (TAB_1.FF + TAB_1.f0)                               ;
 S_E2 = ((4.*TAB_1.HFIN)+(2.*TAB_1.LARG_ESP)+(TAB_1.LFIN))*
 (TAB_1.FF)                                ;
 S_E3 = 2.* (TAB_1.LFIN * (TAB_1.HFIN  - TAB_1.RFIN))  ;
 S_E4 = PI * ( TAB_1.RFIN * TAB_1.LFIN)                ;
 S_E5 = 2. * (( TAB_1.HFIN + TAB_1.LARG_ESP) * TAB_1.f0)    ;
 S_E6 = TAB_1.RFIN * ((2.*TAB_1.f0)-(PI* TAB_1.RFIN))    ;
 FACF = (S_E2+S_E3+S_E4+S_E5+S_E6)/ S_E1 ;
 SINON ;
FACF = 1. ;
FINSI ;
*fin modif

 TAB_1.FACCF = FACF ;
 TAB_1.HYP_SM = SM ;
FINSI                                                            ;
SI ( YTW1 > 0. )     ;
 QUAS = 4. * ( ( PI * DIAM * DIAM / 8.) - ( TTAPE * DIAM / 2. ) ) ;
 PERI =      ( ( PI * DIAM / 2.) -  TTAPE + DIAM        ) ;
 TAB_1.DH   =  QUAS / PERI ;
 PIS2Y =           PI / ( 2. * YTW1 ) ;
 FACV = ( 1. + ( PIS2Y ** 2 )  )  ** 0.5 ;
 FACF =  1.15 ;
FINSI ;
SI ( EXISTE  TAB_1  RIP_FLOWS  ) ;
 S1  =  ( TAB_1 . RIP_FLOWS )    ;
FINSI                            ;
SI ( EXISTE  TAB_1  RIP_WETP  )  ;
 PERI =  ( TAB_1 . RIP_WETP )    ;
 TAB_1.DH   =  4. * S1 / PERI          ;
FINSI                            ;
SI ( EXISTE  TAB_1  RIP_TWIST  )            ;
 PIS2Y = PI / ( 2. *( TAB_1 . RIP_TWIST ) ) ;
 FACV2 = ( 1. + ( PIS2Y ** 2 )  )  ** 0.5   ;
 FACV  = MAXI ( PROG FACV FACV2 )           ;
FINSI                                       ;

SI ( EGA TAB_1.HYPERVAP FAUX )              ;
 FACD =  ( DIAM / TAB_1.DH ) ** 0.2          ;
 FACT = ( FACV ** 0.8 ) * FACD * FACF        ;
SINON ;
FACD = 1. ;
 FACT = ( FACV ** 0.8 ) * FACD * FACF        ;
FINSI ;
* modif pour calcul W7x provisoire
* adaptation du coef correctif W7X du au swirl
* N CURT  18012000
*  SI ( EGA TAB_1.HYPERVAP FAUX )              ;
*  SI (YTW1 > 0. ) ;
*  FACF = 2.18 * ((YTW1)**(-1 * 0.09))   ;
* FACF = 2.26 * ((YTW1)**(-1 * 0.248))   ;
*  FACD = 1. ;
*  FACV = 1. ;
*  FACT = ( FACV ** 0.8 ) * FACD * FACF        ;
*  SINON ;
*FACD =  ( DIAM / TAB_1.DH ) ** 0.2          ;
*  FACT = ( FACV ** 0.8 ) * FACD * FACF        ;
* FINSI ;
*  SINON ;
* FACD = 1. ;
* FINSI ;
* fin modif
*
* attention modification par R. MITTEAU le 7 fevrier 1994
* j'ai rajoute les  " FIXE " pour pouvoir passer un calcul
* dans lequel l'eau est quasi immobile. Car dans ce cas les valeurs
* sont en dehors des tables

* avant modif
*TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT   ;
*NNU  = @IPOE T_LOC1  TAB_1.ETNNU    ;
*RHO  = @IPOE T_LOC1  TAB_1.ETRHOF   ;
*PR   = @IPOE T_LOC1  TAB_1.ETPRAF   ;
*LLAM = @IPOE T_LOC1  TAB_1.ETLLA    ;
*NNUB = @IPOE T_LOC1  TAB_1.ETNNU    ;

* apres modif raph
*MESS '>>PRESS T_MOY S1' P_LOCAL  T_LOC1 ;
TSAT = @IPOE P_LOCAL1 TAB_1.EPTSAT FIXE  ;
NNU  = @IPOE T_LOC1  TAB_1.ETNNU  FIXE  ;
RHO  = @IPOE T_LOC1  TAB_1.ETRHOF FIXE  ;
PR   = @IPOE T_LOC1  TAB_1.ETPRAF FIXE  ;
LLAM = @IPOE T_LOC1  TAB_1.ETLLA  FIXE  ;
NNUB = @IPOE T_LOC1  TAB_1.ETNNU  FIXE  ;

*
RE  = RHO * ( NNU ** -1 ) * V1 * TAB_1.DH * FACV ;
*
SI ( T_LOC1 < TSAT )                   ;
 LTWALL1  = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25.
                 TSAT pas 25. 350. 400. 450. 500. 1500. 2550.
                 3000. 3500. 20000.         ;
SINON                                 ;
 LTWALL1  = PROG -52. pas 25.  TSAT
   pas 25. 350. 400. 450. 500. 1500. 2550. 3000. 3500.
   20000.                                               ;
FINSI                                                   ;
*
LNNUW = @IPOE LTWALL1  TAB_1.ETNNU 'FIXE' ;
*modif  NCURT 10012000
*calcul nb de Prandtl sur le mur
LPRW = @IPOE LTWALL1  TAB_1.ETPRAF 'FIXE' ;
*fin modif
LTETA = PROG ( DIME LTWALL1 ) * T_LOC1 ;
*
LM_ITETA  = LTWALL1 MASQUE 'INFERIEUR' T_LOC1  ;
LM_STETA  = LTWALL1 MASQUE 'EGSUP'     T_LOC1  ;
*
*SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
 NUS_2 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
 NUS_1 = FACF * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.3 ) ;
 LNUS_2 = PROG ( DIME LTWALL1 ) * NUS_2 ;
 LNUS_1 = PROG ( DIME LTWALL1 ) * NUS_1 ;
 LNUS   = ( LNUS_1 * LM_ITETA ) + ( LNUS_2 * LM_STETA ) ;
 LH_DB = LNUS * LLAM / TAB_1.DH ;
 LFC_DB =  ( LTWALL1 - LTETA ) * LH_DB;
 TITRE 'DITTUS_BOELTER' ;
 EVOFC_DB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_DB ;
*FINSI ;
*
*SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
 NUS1 = FACF * 0.027 * ( RE ** 0.8 ) * ( PR ** ( 1. / 3. )) ;
 LNUS = ( ( LNNUW / NNUB ) ** -0.14 ) *  NUS1 ;
 LH_ST = LNUS * ( LLAM / TAB_1.DH ) ;
 LFC_ST = ( LTWALL1 - LTETA ) * LH_ST ;
 TITRE 'SIEDER_TATE' ;
 EVOFC_ST = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_ST ;
*FINSI ;
*
*SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
 F_P = (1. / ( 1.82 * ( ( LOG RE ) / ( LOG 10.) ) - 1.64 )) ** 2 ;
 X_P = 1.07 +
      (12.7 * (PR ** (2. / 3.) - 1.) * ( (F_P / 8.) ** 0.5 ));
 NUS1 = ( RE * PR * F_P ) / ( X_P * 8. ) ;
 LNUS_2 = ( ( LNNUW / NNUB ) ** -0.11 ) * FACF * NUS1  ;
 LNUS_1 = ( ( LNNUW / NNUB ) ** -0.25 ) * FACF * NUS1  ;
 LNUS   =   (LNUS_1 * LM_ITETA) + (LNUS_2 * LM_STETA)  ;
 LH_P = LNUS * ( LLAM /TAB_1.DH ) ;
 LFC_P = ( LTWALL1 - LTETA ) * LH_P ;
 TITRE 'PETHUKOV' ;
 EVOFC_P = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_P ;
*FINSI ;



*modif NCURT 10012000
*adaptation de la correlation non courte de Gnielinski
*cf Greuner 260499
*SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI' ) ;
 F_G = (1. / (1.82 * ( ( LOG RE ) / ( LOG 10.)) - 1.64 )) ** 2 ;
 R_G = ( (PR ** (2. / 3.)) - 1.)
 * ( (F_G / 8.) ** 0.5)  ;
 X_G = 1. + (12.7 * R_G);
 NUS3 = FACF * (((RE - 1000.)* PR) * F_G) / ( X_G * 8.)  ;
* correlation courte
* NUS3 = FACF * 0.012 * ((RE ** 0.87) - 280. ) * (PR ** 0.4) ;
 LNUS = ( ( LPRW / PR ) ** -0.11 ) *  NUS3 ;
 LH_GN = LNUS * ( LLAM/TAB_1.DH) ;
 LFC_GN = ( LTWALL1 - LTETA ) * LH_GN ;
 TITRE 'GNIELINSKI' ;
 EVOFC_GN = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_GN ;

*fin modif


*SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC' ) ;
  SI (NON ( YTW1 EGA 0. 1.E-6 ) )   ;
   FACFJB = 1. + ( 0.7 / YTW1 ) ;
  SINON ;
   FACFJB = 1. ;
  FINSI ;
   NUS_3 = FACFJB * 0.023 * ( RE ** 0.8 ) * ( PR ** 0.4 ) ;
   LNUS = ( ( LNNUW / NNUB ) ** -0.25 ) *  NUS_3 ;
   LH_JB = LNUS * ( LLAM / TAB_1.DH ) ;
   LFC_JB = ( LTWALL1 - LTETA ) * LH_JB ;
   TITRE 'JB_CONVEC' ;
   EVOFC_JB = EVOL MANU 'TEMPERATURE' LTWALL1 'FLUX' LFC_JB ;
*FINSI ;
*
SI ( NON ( EXISTE  TAB_1 L_CONVECT  ) ) ;
*js TAB_1.L_CONVECT = 'DITTUS_BOELTER' ;
 TAB_1.L_CONVECT = 'SIEDER_TATE' ;
FINSI ;
*
SI ( EGA TAB_1.L_CONVECT 'DITTUS_BOELTER' ) ;
 LHCONV = LH_DB ;
FINSI ;
*
SI ( EGA TAB_1.L_CONVECT 'SIEDER_TATE' ) ;
 LHCONV = LH_ST ;
FINSI ;
*
SI ( EGA TAB_1.L_CONVECT 'PETHUKOV' ) ;
 LHCONV = LH_P ;
FINSI ;
*
SI ( EGA TAB_1.L_CONVECT 'JB_CONVEC') ;
 LHCONV = LH_JB ;
FINSI ;

*modif 10012000
SI ( EGA TAB_1.L_CONVECT 'GNIELINSKI') ;
 LHCONV = LH_GN ;
FINSI ;
*fin modif

*
* Calculation of TONB FONB  Bergles & Rohsenow correlation
*
IONB = 0 ;
TB1  = TSAT + 15. ;
REPETER BOUCONB ;
 IONB = IONB + 1 ;
 SI ( IONB >  7 ) ;
  QUITTER BOUCONB ;
 FINSI ;
 PRATIO = P_LOCAL1 * 1.E-5 ;
 EXPO1 = 1. / ( 0.463 * ( PRATIO ** 0.0234 ) ) ;
 DUM = ( 1. / 0.556 ) * ( TB1 - TSAT ) ;
 FTBA = 1082. *( PRATIO ** 1.156 )* ( DUM ** EXPO1 ) ;
 HCONV = IPOL TB1 LTWALL1 LHCONV ;
 FTB = ( HCONV * ( TB1 - T_LOC1 ) ) - FTBA ;
;
* **** CALCUL DE LA DERIVEE PAR RAPPORT A TB1-TETA  **********
 FTB1 = HCONV - ( ( EXPO1 * FTBA ) / ( TB1 - TSAT  )  ) ;
* **** CALCUL DU NOUVEAU TB                 **********
 TONB = TB1 - ( FTB / FTB1 ) ;
 SI ( ( ABS ( TONB -TB1 ) )  <EG 0.1 ) ;
  QUITTER BOUCONB ;
 FINSI ;
 TB1 = TONB ;
FIN     BOUCONB ;
MESS '>@CALHCON> TONB VALUE BY BERG.& ROHS. CORREL.: ' TONB  ;
MESS '>@CALHCON> TONB PRECISION                    : '
               ((TONB - TB1) / TONB);
*
*
SI ( T_LOC1 < TSAT )                   ;
 LTWALL2 = PROG -52. pas 25. (T_LOC1 + 0.01) pas 25. TSAT
                 pas 5. (TONB + 0.01) pas 5.
                 (TONB + 50.) pas 25.
                 450. 500. 1500. 3000. 2.1E4 ;
SINON                                 ;
 LTWALL2  =  PROG -52. pas 25.  TSAT
                 pas 5. (TONB + 0.01) pas 5.
                 (TONB + 50.) pas 25.
                 450. 500. 1500. 3000. 2.1E4 ;
FINSI                                                   ;

LTWALL = LTWALL2 ;
*
LHCONV = @ITPLT LTWALL1 LHCONV 'FIXE' LTWALL2 ;
LTETA = PROG ( DIME LTWALL ) * T_LOC1 ;
LTSAT = PROG ( DIME LTWALL ) * TSAT ;
LTONB = PROG ( DIME LTWALL ) * TONB ;
*
LM_ITSAT  = LTWALL MASQUE 'INFERIEUR'   TSAT  ;
LM_STSAT  = LTWALL MASQUE 'EGSUPE' TSAT  ;
LM_ITONB  = LTWALL MASQUE 'INFERIEUR'   TONB  ;
LM_STONB  = LTWALL MASQUE 'EGSUPE' TONB  ;
LM_ITON1  = LTWALL MASQUE 'EGINFE'   TONB  ;
LM_STON1  = LTWALL MASQUE 'SUPERIEUR' TONB  ;
*
*SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
 VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
 LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
 LFB_TM = ( LFB_TM ** 2 ) * 1.E6 ;
 LFB_TM = LFB_TM * LM_STSAT ;
 TITRE 'THOM' ;
 EVOFB_TM = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TM ;
 EVOFB_T1 = EVOFB_TM                                     ;
*FINSI ;
*
SI ( NON ( EXISTE  TAB_1 L_SUBNB ) ) ;
 TAB_1.L_SUBNB = 'THOM_CEA' ;
 SI ( NON ( EXISTE  TAB_1 V_EXPTHOM ) ) ;
  TAB_1 . V_EXPTHOM =   2.8          ;
 FINSI ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
 VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
 LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 22.65 ) ;
 E_TMP  =  TAB_1.V_EXPTHOM / 2.                    ;
 LFB_TMP = (( LFB_TM ** 2  ) ** E_TMP) * 1.E6 ;
 LFB_TMP = LFB_TMP * LM_STSAT ;
 TITRE 'THOM_CEA' ;
 EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP ;
 EVOFB_T1 = EVOFB_T1 ET EVFB_TMP                        ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
 VEXPTM = EXP ( 1.E-5 * P_LOCAL1 / 87. ) ;
 LFB_TM = ( LTWALL - LTSAT ) * ( VEXPTM / 25.72 ) ;
 E_TMJ  =  3 / 2.                    ;
 LFB_TMJ = (( LFB_TM ** 2  ) ** E_TMJ) * 1.E6 ;
 LFB_TMJ = LFB_TMJ * LM_STSAT ;
 TITRE 'T_JAERI' ;
 EVFB_TMJ = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMJ ;
 EVOFB_T1 = EVOFB_T1 ET EVFB_TMJ                        ;
FINSI ;
*
*SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
 VEXPJL = EXP ( 1.E-5 * P_LOCAL1 / 62. ) ;
 LFB_JL = ( LTWALL - LTSAT ) * ( VEXPJL / 25. ) ;
 LFB_JL = ( LFB_JL ** 4 ) * 1.E6 ;
 LFB_JL =  LFB_JL * LM_STSAT ;
 TITRE 'JENS_LOTTES' ;
 EVOFB_JL = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_JL ;
*FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
 D_YIN1 = 7.195 * ( TAB_1.GAM_YIN ** 1.82 ) ;
 D_YIN2 = ( 1.E-5 * P_LOCAL1 ) ** 0.072 ;
 LFB_YIN = ( 1.E6 * ( LTWALL - LTSAT ) ) / ( D_YIN1 * D_YIN2 ) ;
 LFB_YIN = LFB_YIN * LM_STSAT ;
 TITRE 'YIN' ;
 EVFB_YIN = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_YIN ;
FINSI ;
*
TAC1 = TABLE                 ;
TAC1.1 = 'MARQ CROI REGU'    ;
TAC1.2 = 'MARQ PLUS REGU'    ;
TAC1.3 = 'MARQ ETOI REGU'    ;
TAC1.4 = 'MARQ LOSA REGU'    ;
TAC1.5 = 'MARQ CARR REGU'    ;
TAC1.6 = 'MARQ TRIB REGU'    ;
*
TAC2 = TABLE                 ;
TAC2.1 = 'MARQ CARR REGU'    ;
TAC2.2 = 'MARQ LOSA REGU'    ;
TAC2.3 = 'MARQ TRIA REGU'    ;
TAC2.4 = 'MARQ TRIB REGU'     ;
*
MESS '>@CALHCON> VELOCITY (M/S)                  : ' V1         ;

* MESS '>@CALHCON> MASS FLOW RATE ( KG/S )         : '
*                                         (V1 * S1 * RHO)   ;
MESS '>@CALHCON> FLUID TEMPERATURE (C)     : '
                                        T_LOC1     ;
MESS '>@CALHCON> FLUID PRESSURE ( PA )           : '
                                     P_LOCAL1 ;
MESS '>@CALHCON> WATER SATURATION TEMPERATURE(C) : ' TSAT    ;
*MESS '>@CALHCON> TUBE DIAMETER           (M)     : ' DIAM    ;
MESS '>@CALHCON> TUBE HYDRAULIC DIAMETER (M)     : ' TAB_1.DH      ;
MESS '>@CALHCON> SWIRL TAPE THICKNESS    (M)     : ' TTAPE   ;
MESS '>@CALHCON> TWIST RATIO                     : ' YTW1    ;
MESS '>@CALHCON> FLUID DENSITY ( KG/M**3)        : ' RHO     ;
MESS '>@CALHCON> FLUID CONDUCTIVITY ( W/M.K)     : ' LLAM    ;
MESS '>@CALHCON> REYNOLDS NUMBER                 : ' RE       ;
MESS '>@CALHCON> FLUID VISCOSITY    (KG/M.S)     : ' NNU    ;
MESS '>@CALHCON> PRANDTL  NUMBER                 : ' PR    ;
MESS '>@CALHCON> FACTOR DUE TO FIN EFFECT        : ' FACF     ;
MESS '>@CALHCON> FACTOR DUE TO CHANGE ON HYD.DIAM: ' FACD     ;
*MESS '>@CALHCON> FACTOR DUE TO TWISTED VELOCITY  : ' FACV    ;
MESS '>@CALHCON> VELOCITY CORRECTION FACTOR      : 'FACV     ;
MESS '>@CALHCON> TOTAL FACT. DUE TO TWIST or RIP.: ' FACT   ;
MESS '>@CALHCON> NUSS. HEATING    NUMBER         : '
                       ( IPOL 400. LTWALL1 LNUS  )        ;
*MESS ' EXPERIMENTAL CRITICAL FLUX      : ' FCR1          ;
MESS '>@CALHCON> CONV. COEF. (CONVECTION)        : '
                      ( IPOL 400. LTWALL1 LH_DB  )        ;
MESS '>@CALHCON> FC_DB (TWALL = 400 C ) :'
                      ( IPOL 400. LTWALL1 LFC_DB )        ;
*
*
*
SI ( EGA TAB_1.L_SUBNB 'THOM' ) ;
 LFB = LFB_TM ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'THOM_CEA' ) ;
 LFB = LFB_TMP ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'T_JAERI' ) ;
 LFB = LFB_TMJ ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'JENS_LOTTES' ) ;
 LFB = LFB_JL ;
FINSI ;
*
SI ( EGA TAB_1.L_SUBNB 'YIN' ) ;
 LFB = LFB_YIN                 ;
 TAB_1.CONNECT_METHOD = 'ADDITION'  ;
FINSI ;
*
SI ( EXISTE  TAB_1  AMPL_H )             ;
 LHCONV = LHCONV * ( TAB_1 . AMPL_H )    ;
FINSI                                    ;
*
LFCONV = ( LTWALL - LTETA ) * LHCONV                       ;
TITRE TAB_1.L_CONVECT 'CONVECTION FLUX'                    ;
EVOFC = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
TITRE TAB_1.L_SUBNB 'BOILING FLUX'                         ;
EVOFE  = EVOL MANU 'TEMPERATURE' LTWALL 'CONVECTION' LFB   ;
*
SI ( NON ( EXISTE TAB_1 CONNECT_METHOD ) ) ;
 TAB_1.CONNECT_METHOD = 'BERG_ROH'          ;
FINSI                                      ;
*
SI ( EGA TAB_1.CONNECT_METHOD 'ADDITION' ) ;
 TAB_1.L_SUBNB = 'YIN'                     ;
 MESS '>@CALHCON> ADDITION DE FSPL ET FSCB CHOISIE '  ;
 LFT = LFCONV + LFB                        ;
FINSI                                      ;
*
SI ( EGA TAB_1.CONNECT_METHOD 'DIRECT' ) ;
 PA_TEMPE = 10.                          ;
 TEMPE_PA = TSAT                         ;
 FLUX_DIC = @IPOE TEMPE_PA EVOFC          ;
 FLUX_DIE = @IPOE TEMPE_PA EVOFE          ;
* Recherche du point d'intersection
 REPETER BOUC_DIR                        ;
  SI ( ( ABS ( FLUX_DIE - FLUX_DIC ) ) <EG 1.E2 ) ;
   QUITTER BOUC_DIR                      ;
  FINSI                                  ;
  SI ( FLUX_DIE > FLUX_DIC )             ;
   TEMPE_PA = TEMPE_PA - PA_TEMPE        ;
   PA_TEMPE = PA_TEMPE / 2.              ;
  FINSI                                  ;
  TEMPE_PA = TEMPE_PA + PA_TEMPE         ;
  FLUX_DIC = @IPOE TEMPE_PA EVOFC         ;
  FLUX_DIE = @IPOE TEMPE_PA EVOFE         ;
 FIN BOUC_DIR                            ;
 RANGE_D = (LTWALL MASQUE 'INFE' 'SOMME' TEMPE_PA) + 1 ;
 LTWALL_D = INSERER LTWALL RANGE_D TEMPE_PA       ;
 LFCONV_D = INSERER LFCONV RANGE_D FLUX_DIC       ;
 LFB_D = INSERER LFB RANGE_D FLUX_DIE             ;
 LM_IFLUX = LFCONV_D MASQUE 'INFERIEUR' FLUX_DIC  ;
 LM_SFLUX = LFB_D    MASQUE 'EGSUPE' FLUX_DIE     ;
 LFCONVI = LFCONV_D * LM_IFLUX                    ;
 LFBS = LFB_D * LM_SFLUX                          ;
 LFT = LFCONVI + LFBS                             ;
 LTWALL = LTWALL_D                                ;
 LFCONV = LFCONV_D                                ;
 LFB = LFB_D                                      ;
 LTETA = PROG ( DIME LTWALL_D ) * T_LOC1    ;
FINSI                                    ;
*
SI ( EGA TAB_1.CONNECT_METHOD 'BERG_ROH' ) ;
 LFCONV1 = LFCONV * LM_ITONB              ;
 LFCONV2 = LFCONV * LM_STONB              ;
 FB_ONB = IPOL TONB LTWALL LFB            ;
 LFB_ONB = PROG (DIME LTWALL) * FB_ONB    ;
 LDFB   = ( LFB - LFB_ONB ) * LM_STONB    ;
 LF = ( LFCONV2 ** 2 ) + ( LDFB ** 2 )    ;
 LF = LF ** 0.5                           ;
 LF = LF * LM_STONB                       ;
 LFT = LFCONV1 + LF                       ;
FINSI                                     ;
*
SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' )                  ;
*
*liaison par flux = a Tparoi**10 + b
* LA_1 = ( LFB_ONB1 - LFB_ONB ) /  (( LTONB1 ** 10 ) -
*              ( LTONB ** 10 ) )                             ;
* LB_1 = LFB_ONB - ( LA_1 * ( LTONB ** 10 ) )                ;
* LFPB =  ( LA_1 * ( LTWALL_6 ** 10 ) ) + LB_1               ;
*
 FB_ONB4 = IPOL TONB LTWALL LFB                              ;
 FB_ONB5 = IPOL TONB LTWALL LFCONV                           ;
 FB_ONB6 = 2.8 * FB_ONB5                                     ;
* EVFB_TMP = EVOL MANU 'TEMPERATURE' LTWALL 'FLUX' LFB_TMP   ;
 EVFB_TM1 = EVOL MANU 'FLUX' LFB_TMP 'TEMPERATURE' LTWALL    ;
 T_ONB6   = @IPOE FB_ONB6 EVFB_TM1 FIXE                      ;
 RANGE_6 = ( LTWALL MASQUE 'INFE' 'SOMME' T_ONB6 ) + 1       ;
 LTWALL_6 = INSERER LTWALL RANGE_6 T_ONB6                    ;
*
 LM_ITON2  = LTWALL_6 MASQUE 'INFERIEUR' T_ONB6              ;
 LM_STON2  = LTWALL_6 MASQUE 'EGSUPE'    T_ONB6              ;
 LM_ITON3 = LTWALL_6 MASQUE 'INFERIEUR' TONB                 ;
 LM_STON3 = LTWALL_6 MASQUE 'EGSUPE' TONB                    ;
 LFB_ONB4 = PROG ( DIME LTWALL_6 ) * FB_ONB4                 ;
 LFB_ONB6 = PROG ( DIME LTWALL_6 ) * FB_ONB6                 ;
 LTETA1 =  PROG ( DIME LTWALL_6 ) * T_LOC1                   ;
*
 LHCONV1 = @ITPLT LTWALL LHCONV 'FIXE' LTWALL_6              ;
 LFCONV1 = ( LTWALL_6 - LTETA1 ) * LHCONV1                   ;
 LFB1 = @ITPLT LTWALL LFB 'FIXE' LTWALL_6                    ;
 LFCONV2 = LFCONV1 * LM_ITON3                                ;
 LFCONV3 = LFCONV1 * LM_STON3                                ;
 LFCONV3 = LFCONV3 * LM_ITON2 ;
 LB_1 = ( ( LFB_ONB6 ** 2 ) - ( LFCONV3 ** 2 ) ) /
              ( ( LFB_ONB6 - LFB_ONB4 ) ** 2 )               ;
* LB_1 = 1. ;
 LDFB1 = ( LFB1 - LFB_ONB4 ) * LM_STON3                      ;
 LFT0 = ( LFCONV3 ** 2 ) + ( LB_1 * ( LDFB1 ** 2 ) )         ;
 LFT0 = LFT0 ** 0.5                                          ;
 LFT0 = LFT0 * LM_STON3                                      ;
 LFT1 = LFCONV2 + LFT0                                       ;
FINSI                                                        ;
*
SI ( NON ( EXISTE TAB_1  PFIXTONB ) )     ;
 TAB_1 . PFIXTONB = FAUX                  ;
FINSI                                     ;
*
SI ( TAB_1 . PFIXTONB )                   ;
 F_ONB1 = IPOL TONB LTWALL LFT            ;
 LF_ONB1 = PROG (DIME LTWALL) * F_ONB1    ;
 LHT = (LFT - LF_ONB1) / (LTWALL - LTONB) ;
 LTETA_1 = LTONB - ( LF_ONB1 / LHT )      ;
 MESS '>@CALHCON> LTETA_1 :'                         ;
 TAB_1 . EV_TETA = EVOL MANU 'TEMPERATURE' LTWALL
                            'TEMPEAU' LTETA_1 ;
SINON ;
 SI ( EGA TAB_1.CONNECT_METHOD 'JB_METHOD' )      ;
  LFT = LFT1 ;
  LHT = LFT1  / (LTWALL_6 - LTETA1 )  ;
  LTWALL = LTWALL_6 ;
 SINON ;
  LHT = LFT  / ( LTWALL - LTETA )           ;
 FINSI ;
FINSI                                      ;

TITRE ' HEAT TRANSFER COEFFICIENT ' ;
EVOCON = EVOL MANU  'TEMPERATURE' LTWALL 'CONVECTION'  LHT   ;
*TITRE TAB_1.L_CONVECT 'CONVECTION FLUX'                     ;
*EVOFC  = EVOL MANU  'TEMPERATURE' LTWALL 'CONVECTION' LFCONV ;
*TITRE TAB_1.L_SUBNB 'BOILING FLUX'                         ;
*EVOFE  = EVOL MANU  'TEMPERATURE' LTWALL 'CONVECTION' LFB    ;
TITRE  ' COMBINED FLUX '                                     ;
EVOFT  = EVOL MANU  'TEMPERATURE' LTWALL 'CONVECTION' LFT    ;
*
TITRE ' COEF. D ECHANGE EN EBULLITION SOUS SATUREE, TONB :' TONB ;
*TITRE ' HEAT TRANSFER COEFFICIENT  , TONB ' TONB ;
TITRE ' CHOSEN CORRELATIONS  ,  TONB ' TONB ;

* modif raph/schlo pour couper l'echange au dessus du flux critique
* en regime transitoire, effectuee par R. MITTEAU le 16 fevrier 94
SI (EXISTE TAB_1 TRANSITOIRE)                                    ;
 SI TAB_1.TRANSITOIRE                                            ;
  SI (EXISTE TAB_1 FLUCRIT1 )                                    ;
   EVBIDON1 = EVOL MANU LFT LTWALL                               ;
   T_CRISE  = @IPOE TAB_1.FLUCRIT1 EVBIDON1                     ;
   H_CRISE  = @IPOE T_CRISE EVOCON                              ;
   RANGENTI = ( LTWALL MASQUE 'INFE' 'SOMME' T_CRISE ) + 1       ;
   LTWALL3  = INSERER LTWALL RANGENTI T_CRISE                    ;
   LHT2     = INSERER LHT    RANGENTI H_CRISE               ;
   LFT2     = INSERER LFT    RANGENTI TAB_1.FLUCRIT1        ;
   MASQ1    = LFT2 MASQUE EGINFE    TAB_1.FLUCRIT1    ;
   MASQ2    = LFT2 MASQUE SUPERIEUR TAB_1.FLUCRIT1    ;
   LHT3     = (LHT2 * MASQ1 ) + MASQ2                            ;
   LFT3     = (LFT2 * MASQ1 ) + MASQ2                            ;
   TITRE ' HEAT TRANSFER COEFFICIENT '                           ;
   EVOCON = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LHT3    ;
   TITRE  ' COMBINED FLUX '                                      ;
   EVOFT  = EVOL MANU 'TEMPERATURE' LTWALL3 'CONVECTION' LFT3    ;
  FINSI                                                          ;
 FINSI                                                           ;
FINSI                                                            ;
*
TAB_1.T_SAT    = TSAT     ;
TAB_1.V_TONB    = TONB     ;
TAB_1.ECONVEC1  = EVOCON   ;
TAB_1.EVOFE1    = EVOFE    ;
*
TAC1 = TABLE                 ;
TAC1.1 = 'MARQ CROI REGU'    ;
TAC1.2 = 'MARQ PLUS REGU'    ;
TAC1.3 = 'MARQ ETOI REGU'    ;
TAC1.4 = 'MARQ LOSA REGU'    ;
TAC1.5 = 'MARQ CARR REGU'    ;
TAC1.6 = 'MARQ TRIB REGU'    ;
*
TAC2 = TABLE                 ;
TAC2.1 = 'MARQ CARR REGU'    ;
TAC2.2 = 'MARQ LOSA REGU'    ;
TAC2.3 = 'MARQ TRIA REGU'    ;
TAC2.4 = 'MARQ TRIB REGU'    ;
*
SI ( NON ( EXISTE TAB_1 C_TRACE ) ) ;
 TAB_1.C_TRACE = FAUX               ;
FINSI                               ;
*
SI  L1TRAC                                                ;
 SI TAB_1.C_TRACE                                        ;
  SI ( EGA TAB_1.L_SUBNB 'YIN' )                         ;
   TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
   DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P
             ET EVOFB_T1 ET EVOFB_JL ET EVFB_YIN)
            XBOR 0. 400. YBOR 0. 7.E7  LEGE TAC1         ;
  SINON                                                  ;
   TITRE 'CONVECTIVE AND SUBCOOLED BOILING CORRELATIONS' ;
   DESSIN ( EVOFC_DB ET EVOFC_ST ET EVOFC_P
            ET EVOFB_T1 ET EVOFB_JL)
            XBOR 0. 400. YBOR 0. 7.E7  LEGE TAC1         ;
   TAB_1.EVOFC_D1 = EVOFC_DB ;
   TAB_1.EVOFC_S1 = EVOFC_ST ;
   TAB_1.EVOFC_P1 = EVOFC_P  ;
   TAB_1.EVOFC_M1 = EVOFC_JB ;
   TAB_1.EVOFB_T2 = EVOFB_T1 ;
   TAB_1.EVOFB_J1 = EVOFB_JL ;
  FINSI                                                  ;
 FINSI                                                   ;
 SI ( TAB_1 . PFIXTONB )                                 ;
  DESSIN TAB_1.EV_TETA
         XBOR T_LOC1 400. YBOR 0. 150000. MIMA     ;
 FINSI                                                   ;
 DESSIN ( EVOFC ET TAB_1.EVOFE1 ET EVOFT )
         XBOR 0. 400. YBOR 0. 7.E7 MIMA LEGE TAC2        ;
 DESSIN TAB_1.ECONVEC1
       XBOR 0. 400. YBOR 0. 700000. MIMA                 ;
FINSI                                                    ;
 TAB_1.EVOFC1 = EVOFC ;
 TAB_1.EVOFT1 = EVOFT ;
*
SI (NIVEAU >EG 4) ;
 MESS '-----------------------------------> exit from @CALHCON ';
FINSI ;

FINPROC ;
**** @CALHRAY
DEBPROC  @CALHRAY TAB1*TABLE                         ;
MESS ' ';
*
* !!! R. MITTEAU !!! attention, procedure standard
*
* un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
* pour les mises a jour
*
*-------------------------------------------------------------------*
*                                                                   *
*    COEFFICIENT D ECHANGE TENANT COMPTE                            *
*    DU RAYONNEMENT                                                 *
*                                                                   *
*-------------------------------------------------------------------*
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5          6        7
*
* --- entrees
*
TZERO   =   TAB1.'TEMP_RAYO'            ;
EPS1    =   TAB1.'EMISSIVITE'           ;
AB_2    =   TAB1.'ABSORPTION'           ;
NIVEAU1 =   TAB1.'NIVEAU'               ;
LTRAC   =   TAB1.'TRAC_GRAPHE'          ;

SI (NIVEAU1 >EG 4 )                                           ;
 MESS '-----------------------------------> calling @CALHRAY ';
FINSI                                                         ;

LTEMR  =  PROG -5000. 0.  50.
  100.   200.  300.  400.  500.  600.  700.  800.  900.
  1000.  1100. 1200. 1300. 1400. 1500. 1600. 1700. 1800. 1900.
  2000.  2100. 2200. 2300. 2400. 2500. 2600. 2700. 2800. 2900.
  3000.  3100. 3200. 3300. 3400. 3500. 3600. 3700. 3800. 3900.
                                                      2.E4    ;
SIGMA =5.67E-8                             ;
TZK  = 273.3                               ;
MESS '>@CALHRAY>  STEFAN CONSTANT                   : ' SIGMA      ;
MESS '>@CALHRAY>  TZERO DEG. C                      : ' TZERO      ;
MESS '>@CALHRAY>  EMISSIVITY                        : ' EPS1       ;
MESS '>@CALHRAY>  ABSORPTION                        : ' AB_2       ;
TZERK  = TZERO + TZK                                    ;
*       MESS '  TEMP        H              FR       '   ;
LISTH = PROG                                 ;
LISFE = PROG                                 ;
IH1 = 0                                      ;
REPETER  CAH1 ( DIME LTEMR )                 ;
 IH1 = IH1 + 1                               ;
 TEMP = EXTR LTEMR IH1                       ;
 TEMK = TEMP + TZK                           ;
 EPSEQ = (( 1./EPS1 ) + (1./AB_2) - 1.) ** -1   ;
*     FE = SIGMA * ((EPS1 * ( TEMK ** 4 )) - (AB_2 * ( TZERK ** 4 )));
 FE = SIGMA * EPSEQ *(  ( TEMK ** 4 ) -  ( TZERK ** 4 )  )   ;
*     H1 =   TEMK ** 3                                       ;
*     H2 = ( TEMK ** 2 ) * ( TZERK      )                    ;
*     H3 = ( TEMK      ) * ( TZERK ** 2 )                    ;
*     H4 =                   TZERK ** 3                      ;
*     H  = SIGMA * EPS1 *  ( H1 + H2 + H3 + H4 )             ;
 SI ( EGA TEMK TZERK 1. )                         ;
   H = FE / 1.                                    ;
 SINON                                            ;
  H = FE / ( TEMK - TZERK )                       ;
 FINSI                                            ;
 LISTH = LISTH ET ( PROG H    )                   ;
 LISFE = LISFE ET ( PROG FE    )                  ;
*     MESS   TEMP   H    FE                       ;
FIN CAH1                                          ;
TITRE '>@CALHRAY> COEFFICIENT ECHANGE DE RAYONNEMENT '       ;
ERAYON = EVOL MANU  'TEMPERATURE' LTEMR
                   'COEFFICIENT ECHANGE'   LISTH  ;
TITRE '>@CALHRAY> FLUX DE CHALEUR RAYONNEE '   ;
EVOFE  = EVOL MANU  'TEMPERATURE' LTEMR  'RAYONNEMENT'  LISFE    ;
TAB1.EVORAYT1 = EVOFE                         ;
TAB1.EHRAYON1 = ERAYON                         ;
*
SI LTRAC ;
 DESSIN EVOFE    XBOR 0. 3900. YBOR 0. 4.E6   ;
 DESSIN ERAYON   XBOR 0. 3900. YBOR 0. 1500.  ;
FINSI;
*
SI (NIVEAU1 >EG 4 )                                           ;
 MESS '-----------------------------------> exiting @CALHRAY ';
FINSI                                                         ;
FINPROC  ERAYON          ;
**** @CALOR
'DEBPROC' @CALOR TAB1*'TABLE   '    PUI1*FLOTTANT   ;
MESS ' ' ;
* pour le calcul de la puissance voir CFLUX
*
  VIN     =  TAB1 . V_IN                    ;
  TIN     =  TAB1 . T_IN                   ;
  CPF = @IPOE TIN TAB1.ETCPF                    ;
 SI ( NON ( EXISTE TAB1 V_EMDOTI))            ;
  RHOIN   = @IPOE TIN TAB1.ETRHOF                                   ;
  NNUIN   = @IPOE TIN TAB1.ETNNU                                    ;
  GIN  = RHOIN * VIN                                                ;
  SI ( EXISTE TAB1  RIP_FLOWS )                                     ;
   EMDOTI = GIN * ( TAB1 . RIP_FLOWS )                              ;
  SINON                                                             ;
   SI ( EGA TAB1.HYPERVAP VRAI )    ;
    TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
                  ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) )     ;
    EMDOTI = GIN *  TAB1.HYP_SM  ;
   SINON   ;
    PI = 3.14159         ;
    DIAM1   = TAB1 . D_MAQUETTE                 ;
    TTAPE   = TAB1 . T_TAPE                     ;
    EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
   FINSI                                                             ;
  FINSI ;
  TAB1.V_EMDOTI = EMDOTI                       ;
 SINON                                         ;
  EMDOTI  = TAB1.V_EMDOTI                      ;
 FINSI                                         ;
*
* Modif jb 01/04/95
* Possibilite de creer une procedure calculant
* la section de passage
*SI ( NON ( EXISTE TAB1 SP ) ) ;
* SI ( EXISTE TAB1 RIP_FLOWS ) ;
*  TAB1.SP = TAB1.RIP_FLOWS    ;
* FINSI                        ;
* SI ( EGA TAB1.HYPERVAP VRAI )    ;
*  TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
*                 ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) )     ;
*  TAB1.SP = TAB1.HYP_SM ;
* SINON                  ;
*  PI = 3.14159         ;
*  DIAM1   = TAB1 . D_MAQUETTE                 ;
*  TTAPE   = TAB1 . T_TAPE                     ;
*  TAB1.SP = ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ;
* FINSI                                        ;
*EMDOTI = GIN * TAB1.SP                        ;
*
  DELT = PUI1 / (EMDOTI * CPF)                 ;
  TOUT = TIN + DELT                            ;
  TAB1.TEMPE_OUT = TOUT                        ;
  SI ( EGA TAB1.HYPERVAP VRAI )                ;
   TAB1.'T_LOCAL' = TIN                        ;
   TAB1.'T_MOY' = TIN                          ;
  SINON                                        ;
   TAB1.'T_LOCAL' = TIN + ((TOUT - TIN) * TAB1.X_LOCAL)     ;
   TAB1.'T_MOY' = (TIN + TOUT) / 2.            ;
  FINSI                                        ;
  MESS '>@CALOR>  TIN              :' TIN      ;
  MESS '>@CALOR>  TOUT DT          :' TOUT  DELT    ;
  MESS '>@CALOR>  TMOY             :' TAB1.'T_MOY'     ;
  MESS '>@CALOR>  T_LOCAL          :' TAB1.'T_LOCAL'      ;
FINPROC                               ;
**** @CAPKPC
DEBPROC @CAPKPC  EV_1*EVOLUTION
                 PC_1*FLOTTANT
                  D_1*FLOTTANT
               FL_INC*FLOTTANT
                 NIV1/ENTIER;
*
* !!! R. MITTEAU !!! attention, procedure standard
*
* un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
* pour les mises a jour
*
* calcul du peaking factor correspondant au pourcentage PC_1
* FL_INC flux incident moyen
* EV_1 evolution donnant le flux en paroi d eau
SI (NON (EXISTE NIV1));
 MESS '---------------------------------> calling  @CAPKPC';
SINON;
 SI (NIV1 >EG 4);
 MESS '---------------------------------> calling  @CAPKPC';
 FINSI;
FINSI;
 P_X_1 = EXTR EV_1 'ABSC' 1 ;
 P_Y_1 = EXTR EV_1 'ORDO' 1 ;
 N1 = DIME P_X_1            ;
 VINT0 = MAXI (SOMME ( EVOL MANU P_X_1 P_Y_1 ))   ;
 SI ( PC_1 >EG 1. )                    ;
  MESS ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 '          ;
  ERRE ' >>>>> CAPKPC POURCENTAGE SUPERIEUR A 1 '          ;
 FINSI                                                    ;
 VA_1  = PC_1 * VINT0                  ;
 VINT1 = VINT0                         ;
 REPETER B__1  N1         ;
  I_1  = DIME P_X_1            ;
  P_X_2 = ENLE P_X_1 I_1       ;
  P_Y_2 = ENLE P_Y_1 I_1       ;
  VINT2 = MAXI (SOMME ( EVOL MANU P_X_2 P_Y_2 ))  ;
  SI( VINT2 <EG VA_1 )                 ;
   X_1 =  EXTR P_X_1 I_1        ;
   X_2 =  EXTR P_X_1 (I_1 - 1)            ;
   Y_1 =  EXTR P_Y_1 I_1        ;
   Y_2 =  EXTR P_Y_1 (I_1 - 1)            ;
   PENTE = (Y_1 - Y_2) / (X_1 - X_2)   ;
   DELTA =  Y_2 ** 2  + ( 2. * PENTE *( VA_1 - VINT2 )) ;
   SI ( DELTA < 0. )                    ;
    MESS ' >>>>> CAPKPC y a un truc DELTA < 0. '          ;
    MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 '  VINT2 VINT1 VA_1    ;
    MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1  '  Y_2 X_2 Y_1 X_1    ;
   FINSI                                                    ;
*   X_11 = X_2 + ((X_1 - X_2) / ( VINT1 - VINT2 )
*              * ( VA_1 - VINT2 ))                ;
   RDELT = DELTA ** 0.5                                 ;
   DX_11 = ( (-1. * Y_2) + RDELT ) / PENTE              ;
   X_11 = X_2 + DX_11                                    ;
   SI ( (DX_11 * ( X_11 - X_1)) > 0. )                    ;
    MESS ' >>>>> CAPKPC y a un truc X_11 X_1 X_2 ' X_11 X_1 X_2;
    MESS ' >>>>> CAPKPC VINT2 VINT1 VA_1 '  VINT2 VINT1 VA_1    ;
    MESS ' >>>>> CAPKPC Y_2 X_2 Y_1 X_1  '  Y_2 X_2 Y_1 X_1    ;
    MESS ' >>>>> CAPKPC PENTE DELTA RDELT'  PENTE DELTA RDELT   ;
   FINSI                                                    ;
   QUITTER B__1                         ;
  FINSI                                 ;
  P_X_1 = P_X_2                             ;
  P_Y_1 = P_Y_2                             ;
  VINT1 =  VINT2                        ;
 FIN B__1                               ;
 FL_PC = VINT0 / X_11                   ;
 AL_1  = 2.* X_11 / D_1                 ;
 PKF_1 =  FL_PC / FL_INC                ;

SI (NON (EXISTE NIV1));
 MESS '---------------------------------> exiting @CAPKPC';
SINON;
 SI (NIV1 >EG 4);
  MESS '---------------------------------> exiting @CAPKPC';
 FINSI;
FINSI;
FINPROC  AL_1 PKF_1 ;
**** @CBGMV
DEBPROC @CBGMV BXG*CHPOINT BYG*CHPOINT BZG*CHPOINT TAB1*TABLE ;
*
********************************************************************
* Procedure de changement de base. On passe de la base cartesienne *
* globale de la machine definie par l'axe du tore dirige suivant   *
* Z et l'axe X situe dans le plan median entre deux bobines a la   *
* base cartesienne du maillage.                                    *
* Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en   *
* coupe Theta constant.  Alain MOAL (Decembre 1995-Janvier 1996)   *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
SI ((VALEUR DIME) EGA 2) ;
   IPLAN = TAB1.<PLAN ;
   SI (EGA IPLAN 'PHICONS') ;
      CT0 = TAB1.<CENTRE_TORE        ;
      CT1 = TAB1.<POINT_SUR_AXE_TORE ;
      P1  = TAB1.<POINT_SUR_OBJET    ;
   FINSI ;
   SI (EGA IPLAN 'THECONS') ;
      THETA0 = TAB1.<THETA0 ;
      CP  = TAB1.CENTRE_PLASMA ;
      RP  = TAB1.<RP ;
      HP  = TAB1.<HP ;
   FINSI ;
SINON ;
   CT0 = TAB1.<CENTRE_TORE        ;
   CT1 = TAB1.<POINT_SUR_AXE_TORE ;
   P1  = TAB1.<POINT_SUR_OBJET    ;
FINSI ;
ANGPHI0 = TAB1.<ANG_PHI0 ;
*------------------------------------
*
DIM0 = VALEUR DIME ;
SI (DIM0 EGA 2) ;
   OPTI DIME 3;
FINSI ;
*
SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
   X0 Y0 Z0 = COOR CT0 ;
   X1 Y1 Z1 = COOR CT1 ;
   XP1 YP1 ZP1 = COOR P1  ;
*
*  ---- Calcul des coordonnees du point P0, projection du point P1 de
*  ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
   A = X1 - X0 ;
   B = Y1 - Y0 ;
   C = Z1 - Z0 ;
*
   SI (A EGA 0.) ;
      SI (B EGA 0.) ;
         XP0 = XP1 ;
         YP0 = YP1 ;
         ZP0 = Z0  ;
      FINSI ;
      SI (C EGA 0.) ;
         XP0 = XP1 ;
         YP0 = Y0  ;
         ZP0 = ZP1 ;
      FINSI ;
      SI ((B NEG 0.) ET (C NEG 0.)) ;
         XP0 = XP1 ;
         YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0))
               /(B*B + (C*C)) ;
         ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
      FINSI ;
   SINON ;
      AUX1 = A / (A*A + (B*B) + (C*C)) ;
      AUX2 = (B*B + (C*C)) / A ;
      XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) +
            (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
      YP0 = B * (XP0 - XP1) / A + YP1 ;
      ZP0 = C * (XP0 - XP1) / A + ZP1 ;
   FINSI ;
*
   P0 = XP0 YP0 ZP0 ;
*
*  ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
*  ---- du repere global
   LIG0 = CT0 D 1 P0 ;
   LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
*
*  ---- Calcul des 3 vecteurs unitaires du repere global
   P0X  = LIG1 POIN FINAL ;
   DIR1 = P0X MOIN CT0 ;
   VEC1 = DIR1 / (NORM DIR1) ;
   DIR3 = CT1 MOIN CT0 ;
   VEC3 = DIR3 / (NORM DIR3) ;
   VEC2 = VEC3 PVEC VEC1 ;
*
*  ---- Changement de repere
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   BXM = (A1 * BXG) + (A2 * BYG) + (A3 * BZG) ;
   BYM = (B1 * BXG) + (B2 * BYG) + (B3 * BZG) ;
   BZM = (C1 * BXG) + (C2 * BYG) + (C3 * BZG) ;
*
SINON ;
*
*  ---- en 2D pour une section a Theta constant
   XCP YCP ZCP = COOR CP ;
   NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
   ANG1 = ATG XCP YCP ;
*
*  ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
   BX1 = -1. * BXG * (SIN ANGPHI0) + (BYG * (COS ANGPHI0)) ;
   BY1 = -1. * BXG * (COS ANGPHI0) - (BYG * (SIN ANGPHI0)) ;
   BZ1 = BZG ;
*
*  ---- Rotation de -THETA0 par rapport a l'axe X
   BX2 = BX1 ;
   BY2 = BY1 * (COS THETA0) - (BZ1 * (SIN THETA0)) ;
   BZ2 = BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
*
*  ---- Rotation de ANG1 par rapport a l'axe Z
   BXM = BX2 * (COS ANG1) + (BY2 * (SIN ANG1)) ;
   BYM = -1. * BX2 * (SIN ANG1) + (BY2 * (COS ANG1)) ;
   BZM = BZ2 ;
*
FINSI ;

SI (DIM0 EGA 2) ;
   OPTI DIME 2;
FINSI ;
*
FINPROC BXM BYM BZM ;
**** @CBGTV
DEBPROC  @CBGTV  BX*CHPOINT BY*CHPOINT BZ*CHPOINT
                 THETA*CHPOINT PHI*CHPOINT ;
*
**********************************************************************
* Procedure de changement de base pour un vecteur B de coordonnees   *
* BX, BY, BZ dans la  base globale aux coordonnees pseudo-toroidales *
* BRHO, BTHETA, BPHI.          Alain MOAL (mars 1996)                *
**********************************************************************
*
*---- Rotation de Phi autour de "l'axe Theta"
BRHO1   = (COS PHI) * BX  + ((SIN PHI) * BY) ;
BTHETA1 = BZ ;
BPHI1   = -1.*(SIN PHI) * BX + ((COS PHI) * BY)  ;
*
*---- Rotation de Theta autour de "l'axe Phi"
BRHO   = (COS THETA) * BRHO1 + ((SIN THETA) * BTHETA1) ;
BTHETA = -1.*(SIN THETA) * BRHO1 + ((COS THETA) * BTHETA1) ;
BPHI   = BPHI1  ;
*
FINPROC BRHO BTHETA BPHI ;
**** @CBLMV
DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
*
********************************************************************
*     Version amelioree de l'ancien @CBLMV rebaptise @ACBLM        *
* Procedure de changement de base. On passe de la base cartesienne *
* locale de l'objet modelise a la base cartesienne du maillage.    *
* l'axe Y est dirige du point de tangence au plasma vers le centre *
* du plasma. En 3D, L'axe X du repere local est dans la direction  *
* toroidale.                                                       *
* en 2D cas PHICONS   l'axe Z du repere local est l'axe toroidal   *
* en 2D cas THECONS l'axe x du repere local est l'axe toroidal     *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)          *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VZL ;
      VYL1 = VYL ;
      VZL1 = VXL * (-1.);
*     ---- rotation
      VXM = VXL1 * (COS ANG1)  + (VYL1 * (-1.) * (SIN ANG1));
      VYM = VXL1 * (SIN ANG1)  + (VYL1 * (COS ANG1)) ;
      VZM = VZL1 ;
   FINSI ;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXM = VXL * (COS ANG1)  + (VYL * (-1.) * (SIN ANG1)) ;
      VYM = VXL * (SIN ANG1)  + (VYL * (COS ANG1)) ;
      VZM = VZL ;
   FINSI;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
   VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
   VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
*
FINSI ;
FINPROC VXM VYM VZM ;

**** @CBMGV
DEBPROC @CBMGV BXM*CHPOINT BYM*CHPOINT BZM*CHPOINT TAB1*TABLE ;
*
********************************************************************
* Procedure de changement de base. On passe de la base cartesienne *
* quelconque du maillage a la base cartesienne globale de la       *
* machine definie par l'axe du tore dirige suivant Z et l'axe X    *
* situe dans le plan median entre deux bobines.                    *
* Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en   *
* coupe Theta constant.   Alain MOAL (Decembre 1995-Janvier 1996)  *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
SI ((VALEUR DIME) EGA 2) ;
   IPLAN = TAB1.<PLAN ;
   SI (EGA IPLAN 'PHICONS') ;
      CT0 = TAB1.<CENTRE_TORE        ;
      CT1 = TAB1.<POINT_SUR_AXE_TORE ;
      P1  = TAB1.<POINT_SUR_OBJET    ;
   FINSI ;
   SI (EGA IPLAN 'THECONS') ;
      THETA0 = TAB1.<THETA0 ;
      CP  = TAB1.CENTRE_PLASMA ;
      RP  = TAB1.<RP ;
      HP  = TAB1.<HP ;
   FINSI ;
SINON ;
   CT0 = TAB1.<CENTRE_TORE        ;
   CT1 = TAB1.<POINT_SUR_AXE_TORE ;
   P1  = TAB1.<POINT_SUR_OBJET    ;
FINSI ;
ANGPHI0 = TAB1.<ANG_PHI0 ;
*------------------------------------
*
DIM0 = VALEUR DIME ;
SI (DIM0 EGA 2) ;
   OPTI DIME 3;
FINSI ;
*
SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
*  ---- en 3D ou en 2D pour la section Phi constant
   X0 Y0 Z0 = COOR CT0 ;
   X1 Y1 Z1 = COOR CT1 ;
   XP1 YP1 ZP1 = COOR P1  ;
*
*   ---- Calcul des coordonnees du point P0, projection du point P1 de
*   ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
   A = X1 - X0 ;
   B = Y1 - Y0 ;
   C = Z1 - Z0 ;
*
   SI (A EGA 0.) ;
      SI (B EGA 0.) ;
         XP0 = XP1 ;
         YP0 = YP1 ;
         ZP0 = Z0  ;
      FINSI ;
      SI (C EGA 0.) ;
         XP0 = XP1 ;
         YP0 = Y0  ;
         ZP0 = ZP1 ;
      FINSI ;
      SI ((B NEG 0.) ET (C NEG 0.)) ;
         XP0 = XP1 ;
         YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0))
               /(B*B + (C*C)) ;
         ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
      FINSI ;
   SINON ;
      AUX1 = A / (A*A + (B*B) + (C*C)) ;
      AUX2 = (B*B + (C*C)) / A ;
      XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) +
            (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
      YP0 = B * (XP0 - XP1) / A + YP1 ;
      ZP0 = C * (XP0 - XP1) / A + ZP1 ;
   FINSI ;
*
   P0 = XP0 YP0 ZP0 ;
*
*   ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
*   ---- du repere global
   LIG0 = CT0 D 1 P0 ;
   LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
*
*   ---- Calcul des 3 vecteurs unitaires du repere global
   P0X  = LIG1 POIN FINAL ;
   DIR1 = P0X MOIN CT0 ;
   VEC1 = DIR1 / (NORM DIR1) ;
   DIR3 = CT1 MOIN CT0 ;
   VEC3 = DIR3 / (NORM DIR3) ;
   VEC2 = VEC3 PVEC VEC1 ;
*
*   ---- Changement de repere
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   BXG = (A1 * BXM) + (B1 * BYM) + (C1 * BZM) ;
   BYG = (A2 * BXM) + (B2 * BYM) + (C2 * BZM) ;
   BZG = (A3 * BXM) + (B3 * BYM) + (C3 * BZM) ;
*
SINON ;
*  ---- en 2D pour une section a Theta constant
*
   XCP YCP ZCP = COOR CP ;
   NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
   ANG1 = ATG XCP YCP ;
*
*  ---- Rotation de - ANG1 par rapport a l'axe Z
   BX1 = BXM * (COS ANG1) - (BYM * (SIN ANG1)) ;
   BY1 = BXM * (SIN ANG1) + (BYM * (COS ANG1)) ;
   BZ1 = BZM ;
*
*  ---- Rotation de THETA0 par rapport a l'axe X
   BX2 = BX1 ;
   BY2 = BY1 * (COS THETA0) + (BZ1 * (SIN THETA0)) ;
   BZ2 = -1. * BY1 * (SIN THETA0) + (BZ1 * (COS THETA0)) ;
*
*  ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
   BXG = -1. * BX2 * (SIN ANGPHI0) - (BY2 * (COS ANGPHI0)) ;
   BYG = BX2 * (COS ANGPHI0) - (BY2 * (SIN ANGPHI0)) ;
   BZG = BZ2 ;
*
FINSI;
*
SI (DIM0 EGA 2) ;
   OPTI DIME 2;
FINSI ;
*
FINPROC BXG BYG BZG ;

**** @CBMLV
DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
*
********************************************************************
*     Version amelioree de l'ancien @CBMLV rebaptise @ACBML        *
* Procedure de changement de base. On passe de la base cartesienne *
* du maillage a la base cartesienne locale de l'objet modelise.    *
* l'axe Y final est dirige du point de tangence vers le centre du  *
* plasma. En 3D l'axe x du repere local est donne par la direction *
* toroidale                                                        *
* en 2D cas PHICONS   l'axe Z initial est l'axe toroidal           *
* en 2D cas THECONS l'axe x initial est l'axe toroidal             *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)          *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VXM * (COS ANG1)         + (VYM * (SIN ANG1));
      VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
      VZL1 = VZM ;
*     ---- Coupe 2D a Phi constant
      VXL = VZL1 ;
      VYL = VYL1 ;
      VZL = VXL1 * (-1.);
   FINSI ;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXL = VXM * (COS ANG1)          + (VYM * (SIN ANG1));
      VYL = VXM * (-1.) * (SIN ANG1)  + (VYM * (COS ANG1));
      VZL = VZM ;
   FINSI ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
   VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
   VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
*
FINSI ;
FINPROC VXL VYL VZL ;
**** @CBTGV
DEBPROC  @CBTGV  BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT
                 THETA*CHPOINT PHI*CHPOINT ;
*
*********************************************************************
* Procedure de changement de base pour un vecteur B de coordonnees  *
* BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
* cartesiennes BX, BY, BZ dans la base globale de la machine.       *
*                 Alain MOAL (decembre 1995)                        *
*********************************************************************
*
*---- Rotation de - Theta autour de "l'axe Phi"
BRHO1   = (COS THETA) * BRHO - ((SIN THETA) * BTHETA) ;
BTHETA1 = (SIN THETA) * BRHO + ((COS THETA) * BTHETA) ;
BPHI1   = BPHI  ;
*
*---- Rotation de - Phi autour de "l'axe Theta"
BRHO2   = (COS PHI) * BRHO1  - ((SIN PHI) * BPHI1) ;
BTHETA2 = BTHETA1 ;
BPHI2   = (SIN PHI) * BRHO1 + ((COS PHI) * BPHI1)  ;
*
BX = BRHO2 ;
BY = BPHI2 ;
BZ = BTHETA2 ;
*
FINPROC BX BY BZ ;
**** @CBTLV
DEBPROC  @CBTLV  BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT
                 THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
*
*********************************************************************
* Procedure de changement de base pour un vecteur B de coordonnees  *
* BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
* cartesiennes BX, BY, BZ dans la base de l'objet.                  *
*                 Alain MOAL (juin 1995)                            *
*********************************************************************
*
*--------------- VARIABLES D'ENTREE :
THETA0 =  TAB1.<THETA0 ;
*------------------------------------
*
CT   = COS THETA  ;
ST   = SIN THETA  ;
CT0  = COS THETA0 ;
ST0  = SIN THETA0 ;
MST0 = ST0 * -1.  ;
CPHI = COS PHI    ;
SPHI = SIN PHI    ;
MSPHI= SPHI * -1. ;
*
*---- 1) rotation de - Theta autour de "l'axe Phi"
BRHO1   = (CT * BRHO) - (ST * BTHETA)         ;
BTHETA1 = (ST * BRHO) + (CT * BTHETA)         ;
BPHI1   =                               BPHI  ;
*
*---- 2) rotation de - Phi autour de "l'axe Theta"
BRHO2   = (CPHI * BRHO1)            + (MSPHI * BPHI1) ;
BTHETA2 =                   BTHETA1                   ;
BPHI2   = (SPHI * BRHO1)            + (CPHI * BPHI1)  ;
*
*---- 3) rotation de Theta0 autour de "l'axe Phi"
BRHO3   = (BRHO2 * CT0)    + (BTHETA2 * ST0)        ;
BTHETA3 = (BRHO2 * MST0)   + (BTHETA2 * CT0)        ;
BPHI3   =                                     BPHI2 ;
*
*---- 4) composantes dans le repere cartesien
BX = BPHI3         ;
BY = BRHO3 * -1.   ;
BZ = BTHETA3       ;
*
FINPROC BX BY BZ;
**** PROP_PHY
DEBPROC PROP_PHY TAB_1*TABLE                         ;
******************************************************************************
*****            CELATA94                                                *****
******************************************************************************
* CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE CELATA 94
*_____________________________________________________________________________
*
*
*
*-----------------------------------------------------
* Calcul des proprietes de l eau a la temperature de
* saturation correspondant a la pression de sortie
*-----------------------------------------------------
*
@TABEAU TAB_1                                         ;
POUT = TAB_1.'P_LOCAL'                                ;
TAB_1.TTSAT = @IPOE POUT TAB_1.EPTSAT                 ;
TSAT = TAB_1.TTSAT                                   ;
TAB_1.CCPLOUT = @IPOE TSAT TAB_1.ETCPF                ;
TAB_1.RRHOL = @IPOE TSAT TAB_1.ETRHOF                 ;
TAB_1.RRHOV = @IPOE TSAT TAB_1.ETRHOG                 ;
TAB_1.LLLV = @IPOE TSAT TAB_1.ETHFG                   ;
TAB_1.LLAM = @IPOE TSAT TAB_1.ETLLA                   ;
TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM                 ;
TAB_1.MMUL = @IPOE TSAT TAB_1.ETNNU                   ;
TAB_1.PPRAL = @IPOE TSAT TAB_1.ETPRAF                 ;
*
*-----------------------------------------------------
* Calcul des proprietes de l eau a la temperature d entree
*-----------------------------------------------------
*
TIN = TAB_1.'T_LOCAL'                                ;
TAB_1.CCPLIN = @IPOE TIN TAB_1.ETCPF                  ;
TAB_1.RRHOLIN = @IPOE TIN TAB_1.ETRHOF                ;
*
*-----------------------------------------------------
* Calcul de quantites utiles
*-----------------------------------------------------
*
PI = 3.1415926                                       ;
D = TAB_1.D_MAQUETTE                                 ;
SI ( NON ( EXISTE TAB_1 T_TAPE ) )                   ;
 TAB_1 . T_TAPE = 0.                                 ;
FINSI                                                ;
TTAPE = TAB_1 . T_TAPE                               ;
SI ( NON ( EXISTE TAB_1 TWIST_RATIO  ) )             ;
 TAB_1 . TWIST_RATIO = 0.                            ;
FINSI                                                ;
YTWIST = TAB_1 . TWIST_RATIO                         ;
VIN = TAB_1.'V_LOCAL'                                ;
*
*-----------------------------------------------------
* Prise en compte de l insert torsade
*-----------------------------------------------------
*
SI ( YTWIST EGA 0. )                                 ;
 TAB_1 . DDH = D                                     ;
 FACV = 1.                                           ;
 VP = VIN                                            ;
FINSI                                                ;
SI ( YTWIST > 0. )                                 ;
 QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
 PERI = (( PI * D / 2. ) - TTAPE + D )               ;
 DH = QUAS / PERI                                    ;
 TAB_1 . DDH = DH                                    ;
 PIS2Y = PI / ( 2. * YTWIST )                        ;
 FACV = ( 1. + ( PIS2Y ** 2 ) ) ** ( 1. / 2. )       ;
FINSI                                                ;
*-----------------------------------------------------
* Prise en compte du fil helicoidal
*-----------------------------------------------------
*
SI ( NON ( EXISTE TAB_1 HELI_WIRE ) )                            ;
 TAB_1.HELI_WIRE = FAUX                                          ;
FINSI                                                            ;
SI ( ( YTWIST EGA 0. )  ET  ( EGA TAB_1.HELI_WIRE VRAI ) )       ;
 S1 = PI * D1 * D1 / 4.                                          ;
 SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4.                      ;
 P1 = PI * D                                                     ;
 PM = PI * TAB_1.WIRE_D                                          ;
 DH = 4. * ( S1 - SM ) / ( P1 + PM )                             ;
 PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE )                           ;
 FACV =  ( 1. + ( PIS2Y ** 2 ) ) ** 0.5                          ;
* FACV =  1.                                                      ;
FINSI                                                            ;
*
*-----------------------------------------------------
* Calcul de la vitesse
*-----------------------------------------------------
*
SI (NON (EXISTE TAB_1 FF_SANDIA))                    ;
 TAB_1 .  FF_SANDIA = FAUX                           ;
FINSI                                                ;
F_SANDIA = TAB_1 . FF_SANDIA                         ;
SI  ( F_SANDIA EGA VRAI )                            ;
 FACV = 1.                                           ;
FINSI                                                ;
VP = VIN * FACV                                      ;
TAB_1 . VITPAROI = VP                                ;
*
*-----------------------------------------------------
* Prise en compte du chauffage non asymetrique
*-----------------------------------------------------
*
LH = TAB_1 . L_HEATED                                ;
SI ( NON ( EXISTE  TAB_1  CCHAU_SYM ) )              ;
 TAB_1 . CCHAU_SYM = VRAI                            ;
FINSI                                                ;
SI ( TAB_1 . CCHAU_SYM EGA VRAI )                    ;
 TAB_1.HHAR = PI * D * LH                            ;
 AR = PI * D * D / 4.                                ;
SINON                                                ;
 QUAS = 4. * (( PI * D * D / 8. ) - ( TTAPE * D / 2. )) ;
 AR = QUAS / 4.                                      ;
** PERI = (( PI * D / 2. ) - TTAPE )                  ;
** DHC = QUAS / PERI                                  ;
** TAB_1.HHAR = PI * ( D / 2. ) * LH                   ;
 TAB_1.HHAR =  D  * LH                               ;
FINSI                                                ;
*
MUL = TAB_1.MMUL                                     ;
RHOLIN = TAB_1.RRHOLIN                               ;
G = RHOLIN * VP                                      ;
TAB_1.GGAM = RHOLIN * VP * AR                        ;
TAB_1.GG = G                                         ;
REYL = G * TAB_1 . DDH / MUL                         ;
*
*-----------------------------------------------------
* Calcul du coefficient de frottement
*-----------------------------------------------------
*
* Facteur de Sandia
* multiplier le coefficient de frottement par
* 2.75 * ( YTWIST ** ( - 0.406 ) )
* 2.2 * ( YTWIST ** ( - 0.406 ) )
FA = 4. * 1.375E-3 *
(( 1. + ( 21.544 * ( 0.00375 /( TAB_1 . DDH * 1000. / 2. )))
     + ( 100. / REYL )) ** ( 1. / 3. ))              ;
SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) )      ;
* FA = FA * (2.75 / ( YTWIST ** ( 0.406 ) ))        ;
 FA = FA * (2.2 / ( YTWIST ** ( 0.406 ) ))        ;
FINSI                                                ;
SIGM = TAB_1.SSIGM                                   ;
RHOL = TAB_1.RRHOL                                   ;
REPETER BOUCFA 100                                   ;
 RADEFF = 1.14 - ( 2. * (
LOG ((( 0.72 * SIGM * RHOL ) / ( FA * TAB_1 . DDH * ( G**2 )))
 + ( 9.35 / ( REYL *( FA **( 1. / 2. ))))))/( LOG 10 ))  ;
 DIF1 = ( RADEFF ** (-2))- FA                        ;
 DELTAF = ABS (DIF1)                                 ;
 FA = RADEFF**(-2)                                   ;
 SI ( ( F_SANDIA EGA VRAI ) ET ( YTWIST NEG 0. ) )     ;
*  FA = FA * (2.75 * ( YTWIST ** ( -0.406 ) ))       ;
  FA = FA * (2.2 * ( YTWIST ** ( -0.406 ) ))       ;
  TAB_1.FFA = FA                                     ;
 SINON                                               ;
  TAB_1.FFA = FA                                     ;
 FINSI                                               ;
 SI (DELTAF <EG 1.E-6)                               ;
  QUITTER BOUCFA                                     ;
 FINSI                                               ;
FIN BOUCFA                                           ;
FINPROC                                              ;
*
*_____________________________________________________________________________
*
**** QCALCO
DEBPROC QCALCO TAB_1*TABLE Q*FLOTTANT                ;
*
TIN = TAB_1.T_IN                                 ;
TSAT = TAB_1.TTSAT                                   ;
GAM = TAB_1.GGAM                                     ;
G = TAB_1.GG                                         ;
HAR = TAB_1.HHAR                                     ;
*
*-----------------------------------------------------
* Calcul de la temperature moyenne du fluide
*-----------------------------------------------------
*
CPLIN = TAB_1.CCPLIN                                 ;
CPLOUT = TAB_1.CCPLOUT                               ;
CPLMED = ( CPLIN + CPLOUT )/ 2.                      ;
*MESS ' CPLIN = ' CPLIN ;
*MESS ' CPLOUT = ' CPLOUT ;
*MESS ' CPLMED = ' CPLMED ;
*MESS ' HAR = ' HAR ;
*MESS ' GAM = ' GAM ;
*MESS ' Q = ' Q ;
*TMED = TIN + (( Q * HAR )/( GAM * CPLMED ))          ;
TMED = TIN + (( Q * HAR )/( GAM * CPLIN ))            ;
* MESS 'MEAN FLUID TEMPERATURE (C) :' TMED             ;
*
*-----------------------------------------------------
* Calcul de la temperature de la paroi
*-----------------------------------------------------
*
FA = TAB_1.FFA                                       ;
RHOL = TAB_1.RRHOL                                   ;
PRAL = TAB_1.PPRAL                                   ;
MUL = TAB_1.MMUL                                     ;
D = TAB_1.D_MAQUETTE                                 ;
*MESS ' FA =' FA ;
*MESS ' RHOL = ' RHOL ;
*MESS ' PRAL = ' PRAL ;
*MESS ' MUL = ' MUL ;
*MESS ' D = ' D ;
UTAU = ( FA * ( G **2 ))/(8.*( RHOL**2 ))**(1./2.)   ;
*MESS ' UTAU =' UTAU ;
QU = Q /(RHOL * CPLOUT * UTAU)                       ;
*MESS ' QU = ' QU ;
R = D / 2.                                           ;
TT = 1. + (5.* PRAL )                                ;
*MESS ' TT = ' TT ;
XX = ( R * UTAU * RHOL )/ MUL                        ;
*MESS ' XX = ' XX ;
ZZ = XX - 30.                                        ;
TW = TMED + ( ( 5. * QU / XX ) *
     ( (( PRAL / 2. ) * (( 2. * XX ) - 5. )) +
  (( 5. / PRAL ) * (( TT * ( LOG TT )) + ( 1. - TT )))
      + ( ZZ * ( LOG TT ))
      + (( 1. / 2. ) *
      ((( LOG ( XX / 30. )) * XX ) + ( 30. - XX ))) ));
MESS '>QCALCO> WALL TEMPERATURE        (C) : ' TW           ;
* MESS ' SATURATION TEMPERATURE  (C) : ' TSAT         ;
SI ( TW <EG TSAT )                                   ;
 IFLAG = 1                                           ;
 QUITTER QCALCO                                      ;
 MESS '----->>>>>>>>' ;
FINSI                                                ;
*
*-----------------------------------------------------
* Calcul de l epaisseur de la couche liquide surchauffee
*-----------------------------------------------------
*
*MESS '-----------------------------------> TW>TSAT ' ;
DT1 = QU * PRAL * 5.                                 ;
DT2 = 5.* QU * ( PRAL + ( LOG ( 1. + ( 5. * PRAL ))))   ;
SI (( TW - TSAT ) < DT1 )                          ;
 YPIU = ( TW - TSAT )/( QU * PRAL )                  ;
SINON                                                ;
 SI (( TW - TSAT ) < DT2 )                         ;
  YPIU = 5. + ( ( 5. / PRAL )*
  ( EXP (( TW - TSAT )/( 5. * QU )- PRAL )- 1. ))   ;
 SINON                                               ;
  AA1 = ( TW - TSAT )/( 5. * QU )                    ;
  AA2 = 1. + ( 5. * PRAL )                           ;
  AA = ( AA1 - PRAL - ( LOG AA2 )) * 2.                ;
  YPIU = 30.* (EXP AA)                               ;
 FINSI                                               ;
FINSI                                                ;
YSTAR = ( YPIU * MUL )/( UTAU * RHOL )               ;
* MESS ' SUPERHEATED LAYER THICKNESS (m) : ' YSTAR    ;
*
*-----------------------------------------------------
* Calcul de l epaisseur de l amas de vapeur et de
* sa distance de la paroi chauffee
*-----------------------------------------------------
*
SIGM = TAB_1.SSIGM                                   ;
DB = ( 32. / FA ) * ( SIGM * 0.03 * RHOL /( G**2 ))  ;
DELTA = YSTAR - DB                                   ;
* MESS ' INITIAL LIQUID SUBLAYER THICKNESS (m) : ' DELTA ;
SI (DELTA <EG 0.)                                    ;
 IFLAG = 1                                           ;
 QUITTER QCALCO                                      ;
FINSI                                                ;
*
*-----------------------------------------------------
* Calcul des parametres de l amas de vapeur
*-----------------------------------------------------
*
YPIU = ( DELTA + ( DB / 2. ))* UTAU * RHOL / MUL     ;
SI ( YPIU <EG 5.)                                    ;
 UBL = YPIU * UTAU                                   ;
* MESS ' YPIU <EG 5. ' ;
* MESS ' UBL = ' UBL ;
SINON                                                ;
 SI ( YPIU <EG 30.)                                  ;
  UBL = (( 5. * ( LOG YPIU ) - 3.05 )) * UTAU        ;
*  MESS ' YPIU <EG 30. ' ;
*  MESS ' UBL = ' UBL ;
 SINON                                               ;
  UBL = (( 2.5 *( LOG YPIU )) + 5.5 )* UTAU          ;
*  MESS ' YPIU > 30. ' ;
*  MESS ' UBL = ' UBL ;
 FINSI                                               ;
FINSI                                                ;
RHOV = TAB_1.RRHOV                                   ;
SI ( NON ( EXISTE TAB_1 FFLOW_HO ) )                 ;
 TAB_1 . FFLOW_HO = VRAI                             ;
FINSI                                                ;
SI ( NON ( EXISTE TAB_1 FFLOW_VE  ) )                ;
 TAB_1 . FFLOW_VE = FAUX                             ;
FINSI                                                ;
SI ( TAB_1 . FFLOW_HO EGA VRAI )                     ;
 UB = UBL                                            ;
FINSI                                                ;
SI ( TAB_1 . FFLOW_VE EGA VRAI )                     ;
 CD = (2./3.) *
   DB /(( SIGM /( 9.81 *( RHOL - RHOV )))**(1./2.))  ;
 PI = 3.1415926                                       ;
 C1 = (( 4.* PI * 9.81 *( RHOL + RHOV ) * ( RHOL - RHOV ))
     /(( RHOL **2 )* RHOV * CD)) ** (1./2.)           ;
 UB1 = ( UBL + ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
 UB2 = ( UBL - ((( UBL **2 ) + ( 4. * C1))**(1./2.)))/2. ;
*UB2<0 toujours
 UB = UB1                                             ;
*MESS ' CD = ' CD ;
*MESS ' C1 = ' C1 ;
FINSI                                                ;
*MESS ' UB = ' UB ;
BLB = (2.*PI*SIGM*(RHOL+RHOV))/(RHOL*RHOV*(UB**2))   ;
SI (UB <EG 0.)                                       ;
 MESS 'UB<=0 *** '                                   ;
 IFLAG = 1                                           ;
 QUITTER QCALCO                                      ;
FINSI                                                ;
TAU = BLB/UB                                         ;
*MESS ' TAU = ' TAU ;
*MESS ' IFLAG = ' IFLAG ;
* MESS ' VAPOR BLANKET VELOCITY (m/s) : ' UB          ;
* MESS ' VAPOR BLANKET LENGTH   (m)   : ' BLB         ;
FINPROC DELTA UB UBL BLB TAU IFLAG                   ;
*
*_____________________________________________________________________________
*
**** QUQU
DEBPROC QUQU TAB_1*TABLE Q*FLOTTANT                  ;
*
DELTA = 0.                                           ;
UB = 0.                                              ;
UBL = 0.                                             ;
BLB = 0.                                             ;
TAU = 0.                                             ;
DELTA UB UBL BLB TAU IFLAG = QCALCO TAB_1 Q          ;
SI (IFLAG NEG 0)                                     ;
* MESS ' On quitte la procedure QUQU sans definir FQ ';
 QUITTER QUQU                                        ;
FINSI                                                ;
LLV = TAB_1.LLLV                                     ;
RHOL = TAB_1.RRHOL                                   ;
*MESS 'DELTA =' DELTA                                 ;
*MESS 'RHOL =' RHOL  ;
*MESS 'LLV =' LLV ;
*MESS 'TAU =' TAU ;
*MESS 'UB =' UB                                       ;
*MESS 'UBL =' UBL             ;
*MESS 'Q ='Q                                          ;
FQ = Q - ( DELTA * RHOL * LLV / TAU)                 ;
FINPROC FQ IFLAG                                     ;
*
*_____________________________________________________________________________
*
**** SECANTI
DEBPROC SECANTI TAB_1*TABLE
        X1*FLOTTANT X2*FLOTTANT X1MIN*FLOTTANT
        ERRMAX*FLOTTANT NMAX*ENTIER                  ;
*
SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10))              ;
 IFLAG = 1                                           ;
FINSI                                                ;
SI (IFLAG NEG 0)                                     ;
 QUITTER SECANTI                                     ;
FINSI                                                ;
I = 0                                                ;
F1 IFLAG1 = QUQU TAB_1 X1                            ;
F2 IFLAG2 = QUQU TAB_1 X2                            ;
*MESS ' F1 = ' F1 ;
*MESS ' F2 = ' F2 ;
XPREC = 0.                                           ;
REPETER BOUC4(NMAX)                                  ;
 SI (OU (X1 >EG 10.E10) (X2 >EG 10.E10))             ;
  IFLAG = 1                                          ;
 FINSI                                               ;
 SI (X1 <EG X1MIN)                                   ;
  X1 = X1MIN                                         ;
 FINSI                                               ;
 SI (IFLAG NEG 0)                                    ;
  QUITTER SECANTI                                    ;
 FINSI                                               ;
 X3 = X2-(F2*(X1-X2)/(F1-F2))                        ;
 ERR = (ABS ((XPREC-X3)/X3))*100                     ;
 F3 IFLAG3 = QUQU TAB_1 X3                           ;
* MESS ' F3 = ' F3 ;
 SI ((ERR <EG ERRMAX) ET (F3 <EG 1.E-3))             ;
  QUITTER SECANTI                                    ;
 FINSI                                               ;
 XPREC = X3                                          ;
 I = I + 1                                           ;
 SI ((F1*F3) < 0.)                                   ;
  SI ((F2*F3) < 0.)                                  ;
   A1 = ABS (F3-F1)                                  ;
   A2 = ABS (F3-F2)                                  ;
   SI (A1 > A2)                                      ;
    X1 = X3                                          ;
    F1 = F3                                          ;
   SINON                                             ;
    X2 = X3                                          ;
    F2 = F3                                          ;
   FINSI                                             ;
  SINON                                              ;
   X2 = X3                                           ;
   F2 = F3                                           ;
  FINSI                                              ;
 SINON                                               ;
  SI ((F2*F3) > 0.)                            ;
   A1 = ABS (F3-F1)                                  ;
   A2 = ABS (F3-F2)                                  ;
   SI (A1 > A2)                                      ;
    X1 = X3                                          ;
    F1 = F3                                          ;
   SINON                                             ;
    X2 = X3                                          ;
    F2 = F3                                          ;
   FINSI                                             ;
  SINON                                              ;
   X1 = X3                                           ;
   F1 = F3                                           ;
  FINSI                                              ;
 FINSI                                               ;
FIN BOUC4                                            ;
*MESS ' X3 = ' X3 ;
FINPROC X3 ERR IFLAG                                 ;
*_____________________________________________________________________________
*
**** @CELAT94
DEBPROC @CELAT94 TAB_1*TABLE                         ;
*
* --- entrees
*
NIVEAU = TAB_1.'NIVEAU';
SI (NIVEAU >EG 4);
 MESS '---------------> calling @CELAT94';
FINSI ;

PROP_PHY TAB_1                                       ;
*
NORADICI = 0                                         ;
*DQ = 2.E3                                            ;
DQ = 2.E6                                            ;
Q1 = 0.                                              ;
*Q1 = 20.E6                                           ;
REPETER BOUC2                                        ;
* MESS '---> BOUC2 '                                  ;
 QQ = Q1                                             ;
 IFLAG = 0                                           ;
 QQ = QQ + DQ                                        ;
 FQ IFLAG = QUQU TAB_1 QQ                            ;
* MESS 'FQ =' FQ                                      ;
* MESS '--------------------------IFLAG =' IFLAG      ;
 REPETER BOUC1                                       ;
*  MESS '--> BOUC1 ' ;
  SI (IFLAG <EG 0)                                   ;
   QUITTER BOUC1                                     ;
  FINSI                                              ;
  IFLAG = 0                                          ;
  QQ = QQ + DQ                                       ;
  FQ IFLAG = QUQU TAB_1 QQ                           ;
 FIN BOUC1                                           ;
 SI (FQ >EG 0.)                                      ;
  QUITTER BOUC2                                      ;
 SINON                                               ;
  SI (DQ < 1.E-2)                                    ;
   MESS '---> QUQU HAS NO ZERO '                     ;
   NORADICI = 1                                      ;
   QUITTER BOUC2                                     ;
  FINSI                                              ;
 Q1 = QQ - DQ                                        ;
 DQ = DQ / 2.                                        ;
* MESS ' --------QQ = ' QQ ;
* MESS ' --------Q1 = ' Q1 ;
* MESS ' FQ = ' FQ ;
 FINSI                                               ;
FIN BOUC2                                            ;
*
*MESS '--->BOUC3'                                     ;
*MESS ' **************************** ' ;
*MESS ' **************************** ' ;
*MESS ' **************************** ' ;
*MESS ' **************************** ' ;
*MESS ' **************************** ' ;
Q1 = QQ                                              ;
Q1MIN = Q1                                           ;
Q2 = QQ + DQ                                         ;
*MESS 'Q1 ='Q1  ;
*MESS 'Q1MIN =' Q1MIN ;
*MESS 'Q2 =' Q2 ;
*MESS 'DQ =' DQ ;
*MESS 'NORADICI =' NORADICI ;
REPETER BOUC3                                        ;
 SI (NORADICI EGA 1)                                 ;
  QUITTER BOUC3                                      ;
 FINSI                                               ;
 IFLAG = 0                                           ;
 ERRMAX = 0.00001                                    ;
 SI (OU (Q1 >EG 10.E10) (Q2 >EG 10.E10))             ;
  MESS ' WARNING Q1 OR Q2 EXCEEDED MAXIMUM VALUE '   ;
 QUITTER BOUC3                                       ;
 FINSI                                               ;
 QCAL ERR IFLAG = SECANTI TAB_1
                          Q1 Q2 Q1MIN
                          ERRMAX 500                 ;
 SI (IFLAG NEG 0)                                    ;
  MESS ' PARAMETER PROBLEM IN TEST '                 ;
  IFLAG = 0                                          ;
 FINSI                                               ;
 SI (QCAL EGA 0.)                                    ;
  QUITTER BOUC3                                      ;
 FINSI                                               ;
 QUITTER BOUC3                                       ;
FIN BOUC3                                            ;
*
 MESS 'CELATA94 CRITICAL HEAT FLUX (W/m2) : 'QCAL    ;
*
QCHFW = QCAL                                         ;
DELTA = 0.                                           ;
UB = 0.                                              ;
UBL = 0.                                             ;
BLB = 0.                                             ;
Q1 = 0.                                              ;
Q2 = 0.                                              ;
QCAL = 0.                                            ;
*
TAB_1.CHF = QCHFW ;
SI (NIVEAU >EG 4);
 MESS '---------------> exiting @CELAT94';
FINSI ;
*FINPROC QCHFW                                       ;
FINPROC                                              ;
**** @CERI
DEBPROC @CERI P_1*POINT  P_2*POINT  P_3*POINT R_1*FLOTTANT ;
X_1 = COOR 1 P_1 ;
Y_1 = COOR 2 P_1 ;
X_2 = COOR 1 P_2 ;
Y_2 = COOR 2 P_2 ;
X_3 = COOR 1 P_3 ;
Y_3 = COOR 2 P_3 ;
X_I = (X_1 + X_2 ) / 2.               ;
Y_I = (Y_1 + Y_2 ) / 2.               ;
A_1 = (( X_1 - X_2 ) ** 2 ) + (( Y_1 - Y_2 ) ** 2 ) / 4.  ;
R_12 = R_1 ** 2                                           ;
REPETER   BLO1 1                    ;
  SI ( A_1 EGA R_12 1.E-6 )        ;
   PS_1 = X_I Y_I                  ;
   P_4   = PS_1 PLUS (( Y_1 - Y_I) ( X_I - X_1))            ;
   X_4 = COOR 1 P_4 ;
   Y_4 = COOR 2 P_4 ;
   PSCAL_1 = ((X_I - X_4) * (X_I - X_3))  +
             ((Y_I - Y_4) * (Y_I - Y_3))                 ;
   SI (PSCAL_1 > 0. )                                      ;
    P_4   = PS_1 MOIN (( Y_1 - Y_I) ( X_I - X_1))              ;
   FINSI                                                   ;
   C_ERC1 = (CERC P_1  PS_1   P_4) ET (CERC P_4  PS_1   P_2);
   QUITTER BLO1                                            ;
  FINSI                                                    ;

SI ( ( X_1 - X_2 ) NEG 0. 1.E-6)                          ;

 B_1 = (( Y_1 - Y_2 ) ** 2 ) / (( X_1 - X_2 ) ** 2 ) + 1.  ;
 SI ( A_1 < R_12)        ;

  YS_1 = Y_I + (((R_12 - A_1) / B_1) ** 0.5 )              ;
  XS_1 = X_I - ((YS_1 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 ))   ;
  PS_1 = XS_1 YS_1                                        ;
  PSCAL_1 = ((X_I - XS_1) * (X_I - X_3))  +
            ((Y_I - YS_1) * (Y_I - Y_3))                 ;
  SI (PSCAL_1 < 0. )                                      ;
   YS_2 = Y_I - (((R_12 - A_1) / B_1) ** 0.5 )              ;
   XS_2 = X_I - ((YS_2 - Y_I)*(Y_1 - Y_2 )/(X_1 - X_2 ))   ;
   PS_1 = XS_2 YS_2                                        ;
  FINSI                                                    ;
 C_ERC1 = CERC P_1  PS_1   P_2                 ;
 SINON       ;

  ERRE '>>@CERI>> DISTANCE ENTRE LES 2 POINTS SUPERIEUR AU DIAMETRE ' ;
 FINSI                                                     ;

SINON                                                    ;
  B_1  = (( Y_1 - Y_2 ) ** 2 )  + 1.  ;
  R_12 = R_1 ** 2                                           ;
  YS_1 = Y_I + (((R_12 ) / B_1) ** 0.5 )              ;
  XS_1 = X_I - ((YS_1 - Y_I)*(Y_2 - Y_1 ))   ;
  PS_1 = XS_1 YS_1                                        ;
  PSCAL_1 = ((X_I - XS_1) * (X_I - X_3))  +
            ((Y_I - YS_1) * (Y_I - Y_3))                 ;
  SI (PSCAL_1 < 0. )                                      ;
   YS_2 = Y_I - (((R_12 ) / B_1) ** 0.5)               ;
   XS_2 = X_I - ((YS_2 - Y_I)*(Y_2 - Y_1 ))   ;
   PS_1 = XS_2 YS_2                                        ;
  FINSI                                                    ;
 C_ERC1 = CERC P_1  PS_1   P_2                 ;
FINSI                                                      ;
FIN BLO1                                           ;
FINPROC C_ERC1 PS_1                                 ;


*-----------------------------------------------------------------------
*  Procedure CFLUXTOT
*-----------------------------------------------------------------------
DEBPROC CFLUXTOT TAB1*TABLE;
*
***********************************************************************
*       CFLUXTOT developpee par Nicolas URAGO (avr-sept 1994)         *
* largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
***********************************************************************
******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
*                     traiter que des cas de limiteurs plancher car
*                     Z (point tangent) = Z (centre du plasma)
*
MESS '---------------------------------> calling CFLUXTOT';
*
*-------------------- VARIABLES D'ENTREE
LPAT1  = TAB1.LFLUX_EXTE   ;
GRP1   = TAB1.GRAND_RAYON  ;
IMESS  = TAB1.'NIVEAU'     ;
PTG    = TAB1.'PT_TGPLASMA';
MODEL0 = TAB1.'MODELF'     ;
LAMBQ  = TAB1.LAMDAQ       ;
LISFLU = TAB1.LIS_FLUX     ;
OEIL0  = TAB1.VIEW_P       ;
*
SI (EXISTE TAB1 ANGLE_DEC) ;
   PSI = TAB1.ANGLE_DEC ;
SINON;
   PSI = 0.0 ;
FINSI;
*---------------------------------------
*
*---- On calcule pour chaque point de LPAT1, les coordonnees
*---- de son'centre plasma'.
XP1 = COOR 1 LPAT1 ;
YP1 = COOR 2 LPAT1 ;
ZP1 = COOR 3 LPAT1 ;
GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
XCP1 = XP1 * GRP1 / GRAYP1 ;
YCP1 = YP1 * GRP1 / GRAYP1 ;
*
AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
BETA1 = ATG (AUX1/ZP1) ;
ALPHA2 = ATG YCP1 XCP1 ;
*
*---- le vecteur tangent aux lignes de champ B est orthogonal
*---- a V = P1CP1
VX1 = XCP1 - XP1 ;
VY1 = YCP1 - YP1 ;
VZ1 = ZP1 * -1. ;
*
*---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
*UX1 = SIN (PSI + ALPHA2) ;
*UY1 = (COS (PSI + ALPHA2)) * -1. ;
*UZ1 = UX1 * 0. ;
*
UX1 = SIN (PSI - ALPHA2) ;
UY1 = COS (PSI - ALPHA2) ;
UZ1 = UX1 * 0. ;
*
*---- calcul de B
BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) /
     ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
BZ = BZ**(-0.5) * -1.;
BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
BX = BY * UX1 / UY1 ;
*
*---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
*
*---- Coordonnees du point de tangence
XREF1 = COOR 1 PTG ;
YREF1 = COOR 2 PTG ;
ZREF1 = COOR 3 PTG ;
*
*---- Centre du plasma au dessus du point de tangence
XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
*
*---- DREF1 est le petit rayon du plasma
DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
*
*---- Distance a la DSMF
LDEC1 = DIST1 - DREF1 ;
*
*---- Calcul du profil de flux
VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
VFP1 = FLUX MODEL0 VPAT1 ;
*
*---- Visualisations
ARET0 = ARETE LPAT1 ;
TITRE 'CFLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
TRAC OEIL0 COS_BN LPAT1 ARET0;
TITRE 'CFLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
VB = @CVECT BX BY BZ LPAT1 VERT;
TRAC OEIL0 VB LPAT1 ;
TITRE 'CFLUXTOT : DISTANCE TO THE LCFS' ;
TRAC OEIL0 LDEC1 LPAT1 ARET0;
TITRE 'CFLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
TRAC OEIL0 VPAT1 LPAT1 ARET0;
*
*-------------------- VARIABLES EN SORTIE
*---- flux moyen et puissance
TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
*-----------------------------------------
*
MESS '---------------------------------> exiting CFLUXTOT';
FINPROC VPAT1 ;





**** @CFPFLU

DEBPROC @CFPFLU TAB1*TABLE ;
*
**************************************************************
* Procedure de calcul du profil du depot de puissance sur un *
* objet avec la configuration magnetique de JET.             *
*           Alain MOAL (Janvier - Avril 2001)                *
**************************************************************
* Modif :                                                    *
* 08/11/01 (A.MOAL) : nouveau nom (JETFLU devient CFPFLU)    *
* 08/11/01 (A.MOAL) : calcul de la puissance reelle deposee  *
* 23/11/01 (A.MOAL) : trace de dpsi sur le maillage          *
* 06/12/01 (A.MOAL) : indicateur du passage dans cfpflu      *
* 27/01/04 (A.MOAL) : suppression de l'indicateur <CFPFLU    *
**************************************************************
*
MESS '---------------------------------> calling @CFPFLU';
*
*---- Valeurs par defaut, verification des indices de la table
@VDEFJET TAB1 ;
*
*--------------- VARIABLES D'ENTREE :
MAIL0  = TAB1.<MAILLAGE              ;
MMAIL0 = TAB1.MODELF                 ;
CONT0  = TAB1.LFLUX_EXTE             ;
IMESS  = TAB1.<IMESS                 ;
ITRAC  = TAB1.<ITRAC                 ;
ITYPDEP = TAB1.<TYPE_DEPOT           ;
SI (NON (EXISTE TAB1 <NXM))          ;
   ICALNORM = VRAI                   ;
SINON                                ;
   ICALNORM = FAUX                   ;
   NXM = TAB1.<NXM                   ;
   NYM = TAB1.<NYM                   ;
   NZM = TAB1.<NZM                   ;
FINSI                                ;
SI ((VALEUR DIME) EGA 3)             ;
   OEIL0 = TAB1.VIEW_P               ;
SINON                                ;
   CONTDES0 = TAB1.LFLUX_EXTE_DESS   ;
FINSI                                ;
ICALINCI = TAB1.<CALCUL_INCIDENCE    ;
PUISTOT0 = TAB1.<PUISSANCE_TOTALE    ;
*------------------------------------
*
*TAB1.<CFPFLU = VRAI ;
*
*---- lecture de la carte de champ magnetique dans un fichier
@LECTB TAB1 ;

*--- trace de dpsi sur le maillage
TAB1.<MAILLAGE_B = CONT0 ;
CHDPSI = @DPSI TAB1 ;
TITRE '@CFPFLU : DPSI ON THE MESH' ;
LISOV0 = PROG -0.66 -0.33 0. 1. 2. 3. ;
OPTI ISOV LIGNE ;
TRAC LISOV0 CHDPSI CONT0 ;
OPTI ISOV SURFACE ;
*
*---- lecture du flux normalise sur une ligne dans un fichier
@LECTF TAB1 ;
TITRE '@CFPFLU : MAGNETIC DOMAIN, AREA FOR NORMALIZED FLUX
AND STUDIED OBJECT';
*TRAC (TAB1.<GRILLE_B ET TAB1.<MAILLAGE_FN ET MAIL0) ;
TRAC ((ENVE TAB1.<GRILLE_B) ET (CONT TAB1.<MAILLAGE_FN)
     ET (ENVE MAIL0));
*
*---- calcul du champ B sur la ligne de reference pour
*---- verification des angles d'incidences
SI (ICALINCI) ;
   @VERANG TAB1 ;
FINSI ;

TAB1.<MAILLAGE_B = TAB1.<MAILLAGE_FN ;
BR BZ BPHI = @MAGNB TAB1 ;
*
*---- calcul du champ magnetique sur le maillage
TAB1.<MAILLAGE_B = MAIL0 ;
BR BZ BPHI = @MAGNB TAB1 ;

PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
*AM*11/09/01*BXM = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BYM = BR * (SIN PHI) - (BPHI * (COS PHI));
BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
BZM = BZ ;
MENAGE ;
*
*---- calcul des normales a la surface calculees
*---- dans le repere du maillage
SI (ICALNORM) ;
   NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
   TAB1.<NXM = NXM ;
   TAB1.<NYM = NYM ;
   TAB1.<NZM = NZM ;
FINSI;
MENAGE ;
*
*---- calcul du produit scalaire et de l'angle d'incidence
B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
*
*---- vecteur champ magnetique et vecteur normal dans le repere
*---- du maillage en vue de la visualisation
VB1 = @CVECT BXM BYM BZM CONT0 VERT;
VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
*
*---- dans le plan xy du repere du maillage
BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
*---- dans le plan xz du repere du maillage
BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
*
*---- calcul de la densite de puissance recue par chaque point
VAR1 = @FLNORM TAB1 ;
*
*---- profil du flux pour une puissance de 1 MW deposee sur l'objet
*---- (flux parallele ou perpendiculaire)
SI (ITYPDEP) ;
   PROFIL0 = VAR1 * VBVN ;
SINON ;
   PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
FINSI ;
*
*---- integration du flux sur la surface
PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
*
*---- calcul du flux moyen
PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
*
*---- flux reel deposee pour une puissance donnee en MW
PROFIL1 = PROFIL0 * PUISTOT0 ;
*
*---- traces en 3D
SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
   SI (EGA (VALEUR ELEM) 'CUB8') ;
       ARET1 = ARETE CONT0 ;
   SINON ;
       ARET1 = ARETE CONT0 40. ;
   FINSI ;
   TITRE '@CFPFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
   TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
   TITRE '@CFPFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
   TRACE CACH OEIL0 20 VBVN CONT0 ARET1;
   TITRE '@CFPFLU : 90 - ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)';
   TRACE CACH OEIL0 20 (90. - ANGINCI) CONT0 ARET1;
   TITRE '@CFPFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
   TRACE CACH OEIL0 20 B_NORM CONT0 ARET1 ;
*   TITRE '@CFPFLU : flux0 * exp (- delta / lamdaq)' ;
*   TRACE CACH OEIL0 20 VAR1 CONT0 ARET1;
   TITRE '@CFPFLU : INCIDENT HEAT FLUX FOR 'PUISTOT0' MW' ;
*   TRACE CACH OEIL0 20 PROFIL0 CONT0 ARET1 ;
   TRACE CACH OEIL0 20 PROFIL1 CONT0 ARET1 ;
FINSI ;

SI (IMESS >EG 2) ;
   MESS '>>>> @CFPFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
   MESS '>>>> @CFPFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
   MESS '>>>> @CFPFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
   MESS '>>>> @CFPFLU : PROFIL0 ';
   MESS (MAXI PROFIL0) (MINI PROFIL0) ;
   MESS '>>>> @CFPFLU : PROFIL1 ';
   MESS (MAXI PROFIL1) (MINI PROFIL1) ;
   MESS '>>>> @CFPFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
   MESS '>>>> @CFPFLU : ANGINCI ';
   MESS (MAXI ANGINCI) (MINI ANGINCI) ;
FINSI ;
SI (IMESS >EG 3) ;
   MESS '>>>> @CFPFLU : BXM '; LIST BXM ;
   MESS '>>>> @CFPFLU : BYM '; LIST BYM ;
   MESS '>>>> @CFPFLU : BZM '; LIST BZM ;
   MESS '>>>> @CFPFLU : VBVN '; LIST VBVN ;
   MESS '>>>> @CFPFLU : BETA2DXY '; LIST BETA2DXY ;
   MESS '>>>> @CFPFLU : BETA2DXZ '; LIST BETA2DXZ ;
   MESS '>>>> @CFPFLU : ANGINCI '; LIST ANGINCI ;
   MESS '>>>> @CFPFLU : PROFIL0 '; LIST PROFIL0 ;
   MESS '>>>> @CFPFLU : PROFIL1 '; LIST PROFIL1 ;
FINSI ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.V_FACFM2 = PROMOY ;
TAB1.<ANGINCI = ANGINCI ;
TAB1.<VBVN = VBVN ;
*TAB1.<CFPFLU = FAUX ;
*-------------------------------------
MESS '---------------------------------> exiting @CFPFLU';
FINPROC PROFIL1 ;

**** @CHAMB
DEBPROC @CHAMB TAB1*TABLE XG1*CHPOINT YG1*CHPOINT ZG1*CHPOINT
               ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
*
***********************************************************
* Procedure de calcul du champ magnetique en chaque point *
* en utilisant le modele Seigneur-Hertout de ripple avec  *
* prise en compte du shift de Shafranov.                  *
*             Alain MOAL (juin 1995)                      *
***********************************************************
*123456789012345678901234567890123456789012345678901234567890123456789012
*         1         2         3         4         5         6         7
***********************************************************
*
*MESS '---------------------------------> calling @CHAMB';
*
*--------------- VARIABLES D'ENTREE :
RP      =  TAB1.<RP      ;
HP      =  TAB1.<HP      ;
RHO0    =  TAB1.<RHO0    ;
THETA0  =  TAB1.<THETA0  ;
ANGPHI0 =  TAB1.<ANGPHI0 ;
RR      =  TAB1.<RR      ;
LAMB    =  TAB1.<LAMB    ;
IPLASMA =  TAB1.<IPLASMA ;
COEFA   =  TAB1.<COEFA   ;
COEFB   =  TAB1.<COEFB   ;
COEFC   =  TAB1.<COEFC   ;
EPS     =  TAB1.<EPS     ;
NBOB    =  TAB1.<NBOB    ;
NSPI    =  TAB1.<NSPI    ;
INTENS  =  TAB1.<INTENS  ;
IMESS   =  TAB1.<IMESS   ;
ICHAMP  =  TAB1.<MODEL_CHAMP ;
*------------------------------------
*
PI  = 3.141592 ;
MU0 = PI * 4.E-7 ;
*
*---- Coordonnees de chaque point dans le repere du plasma
RHOP THETAP PHIP = @CRGTC XG1 YG1 ZG1 RP HP ;
*
*---- Masque delimitant le domaine de validite du modele de ripple
*attention domaine de validite etendu de 110 a 180 par
*E.COSTA/E.TSITRONE le 02/06/97
*MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
MASK0 = (ABS THETAP) MASQUE INFERIEUR 181. ;

*
*SI (NON ISHIFT) ;
*   LAMB = -1. ;
*FINSI ;
*
*---- Calcul dans le repere du plasma des composantes du champ
*---- poloidal induit par le courant circulant dans le plasma
AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
*
SI (EGA ICHAMP 'SEIGNEUR') ;
   BPOL_RHO = (RHOP ** -2) * (RHO0**2) - 1. ;
   BPOL_RHO = BPOL_RHO * (LAMB + 0.5)  + (LOG (RHOP / RHO0)) ;
   BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
*
   BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
   BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
   BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
   BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
FINSI ;
*
SI (EGA ICHAMP 'SHAFRANOV') ;
*  ---- cette formulation a ma preference, les 2 autres semblent
* douteuses (A.MOAL)
   BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
   BPOL_RHO = BPOL_RHO * (LAMB + 0.5)  + (LOG (RHOP / RHO0)) ;
   BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
*
   BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
   BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
   BPOL_THE = BPOL_THE * RHOP * (COS THETAP) / (2. * RP) + 1. ;
   BPOL_THE = BPOL_THE * (RHOP ** -1) * AUX0 ;
FINSI ;
*
SI (EGA ICHAMP 'ARTSIMOVICH') ;
   BPOL_RHO = ((RHOP ** -2) * (RHO0**2) - 1.) * -1. ;
   BPOL_RHO = BPOL_RHO * (LAMB + 0.5)  + (LOG (RHOP / RHO0)) ;
   BPOL_RHO = BPOL_RHO * (SIN THETAP) * AUX0 / (2. * RP) ;
*
   BPOL_THE = ((RHOP ** -2) * (RHO0**2)) + 1. ;
   BPOL_THE = BPOL_THE * (LAMB + 0.5) - 1. + (LOG (RHOP / RHO0));
   BPOL_THE = BPOL_THE * (COS THETAP) / 2. + 1. ;
   BPOL_THE = BPOL_THE * AUX0 / RP ;
FINSI ;
*
SI (NON ISHIFT) ;
   BPOL_THE = ((RHOP * 2. * PI / (MU0 * IPLASMA))**(-1))*(-1.) ;
   BPOL_RHO = BPOL_THE * 0. ;
FINSI ;
*
BPOL_PHI = RHOP * 0. ;
*
*---- Passage dans la base cartesienne de la machine
BXPOL BYPOL BZPOL = @CBTGV BPOL_RHO BPOL_THE BPOL_PHI
                              THETAP PHIP ;
*
*---- Coordonnees de chaque point dans le "repere du ripple"
RHOR THETAR PHIR = @CRGTC XG1 YG1 ZG1 RR 0. ;
*
SI IRIPPLE ;
*  ---- Calcul dans le repere adapte au calcul du ripple du champ
*  ---- cree par les bobines toroidales
*
*  ---- 1) calcul de la coordonnee radiale dans le plan meridien Phi=0
*  ----    de la ligne de champ consideree par une methode de point fixe
   RHO_OLD = RHOR ;
   KAUX = (EXP(THETAR**2 * -1. * COEFC)) *
         ((COS((PHIR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
   I = 0 ;
   IMAX = 50 ;
   REPETER BOUCLE IMAX ;
     I = I + 1;
     RHO_NEW = RHOR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
*    MESS ' ITERATIONS NUMBER : ' I ;
*    MESS (maxi RHO_NEW ) ;
     SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) <EG EPS) ;
*        MESS ' ITERATIONS NUMBER : ' I ;
        QUITTER BOUCLE ;
     FINSI ;
     RHO_OLD = RHO_NEW ;
   FIN BOUCLE ;
   SI (I >EG IMAX) ;
      MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
      MESS '>>> PROPOSED SOLUTIONS : ' ;
      MESS '>>>    1) INCREASE THE CONVERGENCE CRITERIUM (TAB1.<EPS) ';
      MESS '>>>    2) CHECK YOU ARE WITHIN MODEL VALIDITY DOMAIN ';
      MESS '>>>    3) ASK FOR THE PROCEDURE CONCEPTOR ';
*EC*      ERRE ' >>> STOP IN @CHAMB';
      ERRE ' >>> STOP IN @CHAMB';
   FINSI ;
   RHOMER = RHO_NEW ;
*
*  ---- 2) composantes du champ (modele Hertout-Seigneur)
   DRHOMER = (EXP(RHOMER * COEFB)) * (EXP(THETAR**2 * COEFC
              * -1.)) * COEFA ;
FINSI ;
RAUX1 = RHOR * (COS THETAR) + RR ;
*
*---- champ toroidal moyen sur le cercle de rayon Rr
BPHI0 = -1. * MU0 * INTENS * NBOB * NSPI / (2. * PI * RR) ;
*
*---- champ toroidal moyen sur le cercle de rayon
*                                   (Rr + Rhor * cos Thetar)
BTPHI0 = (RAUX1 ** -1.) * BPHI0 * RR ;
*
SI IRIPPLE ;

*EC mai 1997*   BTOR_PHI = RHOR / (RAUX1*RHOR) + COEFB ;
                BTOR_PHI = RR   / (RAUX1*RHOR) + COEFB ;

*AM* BTOR_PHI = ((RHOR * RAUX1)**-1)  * (RAUX1 * -1. + (2.*RR)) + COEFB;

   BTOR_PHI = BTOR_PHI * -1. * DRHOMER *
             (COS((PHIR + ANGPHI0) * NBOB)) + 1. ;

  BTOR_PHI = MASK0 * BTOR_PHI * BTPHI0 + ((1.-MASK0) * BTPHI0);
*

  BTOR_RHO = MASK0 * (RAUX1 ** -1.) * DRHOMER * BTPHI0 *
             (SIN((PHIR + ANGPHI0) * NBOB)) * NBOB * (-1.) ;


*
   BTOR_THE = RHOR * 0. ;
*
   RHOMER = MASK0 * RHOMER + ((1.-MASK0) * RHOR) ;
SINON ;
   BTOR_PHI = BTPHI0    ;
   BTOR_RHO = RHOR * 0. ;
   BTOR_THE = RHOR * 0. ;
   RHOMER = RHOR  ;
FINSI ;

*
*---- Passage dans la base cartesienne de la machine
BXTOR BYTOR BZTOR = @CBTGV BTOR_RHO BTOR_THE BTOR_PHI
                              THETAR PHIR ;
*
*---- Normes du champ poloidal et du champ toroidal
N_BPOL = (BXPOL*BXPOL + (BYPOL*BYPOL) + (BZPOL*BZPOL))**0.5 ;
N_BTOR = (BXTOR*BXTOR + (BYTOR*BYTOR) + (BZTOR*BZTOR))**0.5 ;
*
*---- Facteur de securite
FSECU = (RHOP / (RHOP*(COS THETAP)+RP)) * (N_BTOR / N_BPOL) ;
*
*---- Champ total
SI (EXISTE TAB1 MOAL1) ;
    BXPOL = BXPOL*0.;
    BYPOL = BYPOL*0.;
    BZPOL = BZPOL*0.;
FINSI ;
SI (EXISTE TAB1 MOAL2) ;
    BXTOR = BXTOR*0.;
    BYTOR = BYTOR*0.;
    BZTOR = BZTOR*0.;
FINSI ;
BX = BXPOL + BXTOR ;
BY = BYPOL + BYTOR ;
BZ = BZPOL + BZTOR ;
*
*---- Messages de verification du calcul
SI (IMESS >EG 2) ;
   MESS '>>>> @CHAMB ' ;
   MESS 'max and min of the BPOL components in RP' ;
   MESS (MAXI BPOL_RHO) (MINI BPOL_RHO) ;
   MESS (MAXI BPOL_THE) (MINI BPOL_THE) ;
   MESS (MAXI BPOL_PHI) (MINI BPOL_PHI) ;
   MESS 'max and min of the BTOR components in RR' ;
   MESS (MAXI BTOR_RHO) (MINI BTOR_RHO) ;
   MESS (MAXI BTOR_THE) (MINI BTOR_THE) ;
   MESS (MAXI BTOR_PHI) (MINI BTOR_PHI) ;
   MESS 'max and min of the BPOL components' ;
   MESS (MAXI BXPOL) (MINI BXPOL) ;
   MESS (MAXI BYPOL) (MINI BYPOL) ;
   MESS (MAXI BZPOL) (MINI BZPOL) ;
   MESS 'max and min of the BTOR components' ;
   MESS (MAXI BXTOR) (MINI BXTOR) ;
   MESS (MAXI BYTOR) (MINI BYTOR) ;
   MESS (MAXI BZTOR) (MINI BZTOR) ;
   MESS 'max and min of Rho, Theta, Phi in RP';
   MESS (MAXI RHOP) (MINI RHOP) ;
   MESS (MAXI THETAP) (MINI THETAP) ;
   MESS (MAXI PHIP) (MINI PHIP) ;
   MESS 'max and min of X, Y, Z ';
   MESS (MAXI XG1) (MINI XG1) ;
   MESS (MAXI YG1) (MINI YG1) ;
   MESS (MAXI ZG1) (MINI ZG1) ;
FINSI ;
SI (IMESS >EG 3) ;
   MESS '>>>> @CHAMB : BPOL_RHO in RP '; LIST BPOL_RHO;
   MESS '>>>> @CHAMB : BPOL_THE in RP '; LIST BPOL_THE;
   MESS '>>>> @CHAMB : BPOL_PHI in RP '; LIST BPOL_PHI;
   MESS '>>>> @CHAMB : BTOR_RHO in RR '; LIST BTOR_RHO;
   MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
   MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
   MESS '>>>> @CHAMB : BXPOL '; LIST BXPOL;
   MESS '>>>> @CHAMB : BYPOL '; LIST BYPOL;
   MESS '>>>> @CHAMB : BZPOL '; LIST BZPOL;
   MESS '>>>> @CHAMB : BXTOR '; LIST BXTOR;
   MESS '>>>> @CHAMB : BYTOR '; LIST BYTOR;
   MESS '>>>> @CHAMB : BZTOR '; LIST BZTOR;
   MESS '>>>> @CHAMB : BTOR_THE in RR '; LIST BTOR_THE;
   MESS '>>>> @CHAMB : BTOR_PHI in RR '; LIST BTOR_PHI;
   MESS '>>>> @CHAMB : X '; LIST XG1;
   MESS '>>>> @CHAMB : Y '; LIST YG1;
   MESS '>>>> @CHAMB : Z '; LIST ZG1;
   MESS '>>>> @CHAMB : RHO in RP '; LIST RHOP;
   MESS '>>>> @CHAMB : THETA in RP '; LIST THETAP;
   MESS '>>>> @CHAMB : PHI in RP '; LIST PHIP;
   MESS '>>>> @CHAMB : RHO in RR '; LIST RHOR;
   MESS '>>>> @CHAMB : THETA in RR '; LIST THETAR;
   MESS '>>>> @CHAMB : PHI in RR '; LIST PHIR;
   MESS '>>>> @CHAMB : RHOMER '; LIST RHOMER ;
   MESS '>>>> @CHAMB : BPHI0 ' ; LIST BPHI0 ;
FINSI ;
*
*MESS '---------------------------------> exiting @CHAMB';
*
*--------------- VARIABLES DE SORTIE :
TAB1.<RHOMER = RHOMER  ;
TAB1.<BXPOL  = BXPOL   ;
TAB1.<BYPOL  = BYPOL   ;
TAB1.<BZPOL  = BZPOL   ;
TAB1.<BXTOR  = BXTOR   ;
TAB1.<BYTOR  = BYTOR   ;
TAB1.<BZTOR  = BZTOR   ;
*-------------------------------------
FINPROC BX BY BZ FSECU;

**** @CRLTC
DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT
               R*FLOTTANT ;
*
***************************************************************
* Procedure de changement de repere, on passe des             *
* coordonnees cartesiennes dans le repere de local de l'objet *
* XM YM ZM repere defini par  TAB1.<RHO0, TAB1.<THETA0 et     *
* TAB1.<RP aux coordonnees pseudo-toroidales defini par un    *
* grand rayon donne R .            Alain MOAL (mai 1995)      *
***************************************************************
*
*--------------- VARIABLES D'ENTREE :
RHO0   =  TAB1.<RHO0   ;
THETA0 =  TAB1.<THETA0 ;
RP     =  TAB1.<RP     ;
*------------------------------------
*
CT0 = COS THETA0 ;
ST0 = SIN THETA0 ;
MST0 = ST0 * -1. ;
*
*---- 1) rotation d'angle THETA0 autour de l'axe X
X1 = XM                                       ;
Y1 =      (YM * CT0)            + (ZM * ST0)  ;
Z1 =      (YM * MST0)           + (ZM * CT0)  ;
*
*---- 2) changement d'origine vers le centre du tore,
*----    rotation de 180 degres autour de l'axe Z2 pour
*----    retrouver le repere global puis calcul de PHI
X2 = X1                       ;
Y2 = Y1 - (RHO0 * CT0 + RP)   ;
Z2 = Z1 + (RHO0 * ST0)        ;
*
X2 = X2 * -1.  ;
Y2 = Y2 * -1.  ;
PHI = ATG (X2 * -1.) Y2 ;
*
*---- 3) rotation d'angle PHI autour de l'axe Z2
CPHI = COS PHI     ;
SPHI = SIN PHI     ;
MSPHI = SPHI * -1. ;
X3 = (X2 * CPHI)      + (Y2 * SPHI)       ;
Y3 = (X2 * MSPHI)     + (Y2 * CPHI)       ;
Z3 =                                  Z2  ;
*
*---- 4) changement d'origine vers le centre du nouveau repere
X4 = X3     ;
Y4 = Y3 - R ;
Z4 = Z3     ;
*
*---- calcul de RHO et THETA
RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
THETA = ATG Z4 Y4 ;
*
MESS '>>>> @CRLTC : max and min of the angle PHI' ;
MESS (MAXI PHI) (MINI PHI) ;
*
FINPROC RHO THETA PHI ;
**** @CRTLC
DEBPROC  @CRTLC  R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT
                 TAB1*TABLE ;
*
***************************************************************
* Procedure de changement de repere, on passe des coordonnees *
* pseudo-toroidales centrees sur un grand rayon R aux         *
* coordonnees cartesiennes dans le repere de la structure     *
* modelisee.                  Alain MOAL (mai 1995)           *
***************************************************************
*
*--------------- VARIABLES D'ENTREE :
RHO0   =  TAB1.<RHO0   ;
THETA0 =  TAB1.<THETA0 ;
RP     =  TAB1.<RP     ;
*------------------------------------
*
CT0 = COS THETA0 ;
ST0 = SIN THETA0 ;
MST0= ST0 * -1.  ;
CPHI = COS PHI   ;
SPHI = SIN PHI   ;
MSPHI = SPHI * -1. ;
*
X4 = RHO * 0.          ;
Y4 = RHO * (COS THETA) ;
Z4 = RHO * (SIN THETA) ;
*
*---- 1) changement d'origine vers le centre du tore
X3 = X4       ;
Y3 = Y4 + R   ;
Z3 = Z4       ;
*
*---- 2) rotation d'angle - PHI autour de l'axe Z3
*        puis rotation de - 180 degres autour de l'axe Z2
X2 = (X3 * CPHI)    + (Y3 * MSPHI)         ;
Y2 = (X3 * SPHI)    + (Y3 * CPHI)          ;
Z2 =                                  Z3   ;
*
X2 = X2 * -1. ;
Y2 = Y2 * -1. ;
*
*---- 3) changement d'origine vers le centre d'objet
X1 = X2                       ;
Y1 = Y2 + RP + (RHO0 * CT0)   ;
Z1 = Z2 - (RHO0 * ST0)        ;
*
*---- 4) rotation d'angle - THETA0 autour de l'axe X1
XP = X1                             ;
YP =      (Y1 * CT0)  + (Z1 * MST0) ;
ZP =      (Y1 * ST0)  + (Z1 * CT0)  ;
*
FINPROC XP YP ZP ;
**** @CRTTC
DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT
               PHI1*CHPOINT R2*FLOTTANT ;
*
***************************************************************
* Procedure de changement de repere. On passe d'un repere     *
* pseudo-toroidal defini par son grand rayon R1 a un autre    *
* repere pseudo-toroidal defini par son grand rayon R2. Ces   *
* deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
*                 Alain MOAL (juin 1995)                      *
***************************************************************
*
RHO2 = RHO1**2 + ((R1 - R2)**2) ;
RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
RHO2 = RHO2**0.5 ;
*
AUX1 = RHO1 * (SIN THETA1) ;
AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
THETA2 = ATG AUX1 AUX2 ;
*
PHI2 = PHI1 ;
*
FINPROC RHO2 THETA2 PHI2 ;
**** @CRLMC
DEBPROC  @CRLMC  XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
*
*******************************************************************
*    Version amelioree de l'ancien @CRLMC rebaptise @ACRLM        *
* Procedure de changement de repere. On passe du repere cartesien *
* local de l'objet modelise au repere cartesien du maillage. Le   *
* point de tangence au plasma est l'origine du repere local et    *
* l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du  *
* repere local est dans la direction toroidale.                   *
* en 2D cas PHICONS   l'axe Z du repere local est l'axe toroidal  *
* en 2D cas THECONS l'axe x du repere local est l'axe toroidal    *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)         *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   XPTG YPTG = COOR PTG ;
*
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = ZL ;
      ZL = ZL * 0.;
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
*  ---- changement d'origine du repere
   XM = XL1 + XPTG ;
   YM = YL1 + YPTG ;
   ZM = YL1 * 0. ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   X0 Y0 Z0 = COOR PTG ;
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
   YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
   ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
*
   XM = XM1 + X0 ;
   YM = YM1 + Y0 ;
   ZM = ZM1 + Z0 ;
*
FINSI ;
FINPROC XM YM ZM ;
**** @CRMLC
DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
*
*******************************************************************
*    Version amelioree de l'ancien @CRMLC rebaptise @ACRML        *
* Procedure de changement de repere. On passe du repere cartesien *
* du maillage au repere cartesien local de l'objet modelise. Le   *
* point de tangence au plasma est l'origine de ce repere et l'axe *
* l'axe Y final est dirige vers le centre du plasma.              *
* en 3D l'axe x du repere local est donne par la direction        *
* toroidale                                                       *
* en 2D cas PHICONS   l'axe Z initial est l'axe toroidal          *
* en 2D cas THECONS l'axe x initial est l'axe toroidal            *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)         *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   XPTG YPTG = COOR PTG ;
*
*  ---- changement d'origine du repere
   XM1 = XM - XPTG ;
   YM1 = YM - YPTG ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
*
      ZL = XL ;
      XL = XL * 0.;
   FINSI;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
   FINSI ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   X0 Y0 Z0 = COOR PTG ;
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XM1 = XM - X0 ;
   YM1 = YM - Y0 ;
   ZM1 = ZM - Z0 ;
*
   XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
   YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
   ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
*
FINSI ;
FINPROC XL YL ZL ;


**** @CBTLV
DEBPROC  @CBTLV  BRHO*CHPOINT BTHETA*CHPOINT BPHI*CHPOINT
                 THETA*CHPOINT PHI*CHPOINT TAB1*TABLE ;
*
*********************************************************************
* Procedure de changement de base pour un vecteur B de coordonnees  *
* BRHO, BPHI, BTHETA dans une base pseudo-toroidale aux coordonnees *
* cartesiennes BX, BY, BZ dans la base de l'objet.                  *
*                 Alain MOAL (juin 1995)                            *
*********************************************************************
*
*--------------- VARIABLES D'ENTREE :
THETA0 =  TAB1.<THETA0 ;
*------------------------------------
*
CT   = COS THETA  ;
ST   = SIN THETA  ;
CT0  = COS THETA0 ;
ST0  = SIN THETA0 ;
MST0 = ST0 * -1.  ;
CPHI = COS PHI    ;
SPHI = SIN PHI    ;
MSPHI= SPHI * -1. ;
*
*---- 1) rotation de - Theta autour de "l'axe Phi"
BRHO1   = (CT * BRHO) - (ST * BTHETA)         ;
BTHETA1 = (ST * BRHO) + (CT * BTHETA)         ;
BPHI1   =                               BPHI  ;
*
*---- 2) rotation de - Phi autour de "l'axe Theta"
BRHO2   = (CPHI * BRHO1)            + (MSPHI * BPHI1) ;
BTHETA2 =                   BTHETA1                   ;
BPHI2   = (SPHI * BRHO1)            + (CPHI * BPHI1)  ;
*
*---- 3) rotation de Theta0 autour de "l'axe Phi"
BRHO3   = (BRHO2 * CT0)    + (BTHETA2 * ST0)        ;
BTHETA3 = (BRHO2 * MST0)   + (BTHETA2 * CT0)        ;
BPHI3   =                                     BPHI2 ;
*
*---- 4) composantes dans le repere cartesien
BX = BPHI3         ;
BY = BRHO3 * -1.   ;
BZ = BTHETA3       ;
*
FINPROC BX BY BZ;
**** @CBLMV
DEBPROC @CBLMV VXL*CHPOINT VYL*CHPOINT VZL*CHPOINT TAB1*TABLE ;
*
********************************************************************
*     Version amelioree de l'ancien @CBLMV rebaptise @ACBLM        *
* Procedure de changement de base. On passe de la base cartesienne *
* locale de l'objet modelise a la base cartesienne du maillage.    *
* l'axe Y est dirige du point de tangence au plasma vers le centre *
* du plasma. En 3D, L'axe X du repere local est dans la direction  *
* toroidale.                                                       *
* en 2D cas PHICONS   l'axe Z du repere local est l'axe toroidal   *
* en 2D cas THECONS l'axe x du repere local est l'axe toroidal     *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)          *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VZL ;
      VYL1 = VYL ;
      VZL1 = VXL * (-1.);
*     ---- rotation
      VXM = VXL1 * (COS ANG1)  + (VYL1 * (-1.) * (SIN ANG1));
      VYM = VXL1 * (SIN ANG1)  + (VYL1 * (COS ANG1)) ;
      VZM = VZL1 ;
   FINSI ;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXM = VXL * (COS ANG1)  + (VYL * (-1.) * (SIN ANG1)) ;
      VYM = VXL * (SIN ANG1)  + (VYL * (COS ANG1)) ;
      VZM = VZL ;
   FINSI;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   VXM = (A1 * VXL) + (A2 * VYL) + (A3 * VZL) ;
   VYM = (B1 * VXL) + (B2 * VYL) + (B3 * VZL) ;
   VZM = (C1 * VXL) + (C2 * VYL) + (C3 * VZL) ;
*
FINSI ;
FINPROC VXM VYM VZM ;

**** @CBMLV
DEBPROC @CBMLV VXM*CHPOINT VYM*CHPOINT VZM*CHPOINT TAB1*TABLE ;
*
********************************************************************
*     Version amelioree de l'ancien @CBMLV rebaptise @ACBML        *
* Procedure de changement de base. On passe de la base cartesienne *
* du maillage a la base cartesienne locale de l'objet modelise.    *
* l'axe Y final est dirige du point de tangence vers le centre du  *
* plasma. En 3D l'axe x du repere local est donne par la direction *
* toroidale                                                        *
* en 2D cas PHICONS   l'axe Z initial est l'axe toroidal           *
* en 2D cas THECONS l'axe x initial est l'axe toroidal             *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)          *
********************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      VXL1 = VXM * (COS ANG1)         + (VYM * (SIN ANG1));
      VYL1 = VXM * (-1.) * (SIN ANG1) + (VYM * (COS ANG1));
      VZL1 = VZM ;
*     ---- Coupe 2D a Phi constant
      VXL = VZL1 ;
      VYL = VYL1 ;
      VZL = VXL1 * (-1.);
   FINSI ;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      VXL = VXM * (COS ANG1)          + (VYM * (SIN ANG1));
      VYL = VXM * (-1.) * (SIN ANG1)  + (VYM * (COS ANG1));
      VZL = VZM ;
   FINSI ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   VXL = (A1 * VXM) + (B1 * VYM) + (C1 * VZM) ;
   VYL = (A2 * VXM) + (B2 * VYM) + (C2 * VZM) ;
   VZL = (A3 * VXM) + (B3 * VYM) + (C3 * VZM) ;
*
FINSI ;
FINPROC VXL VYL VZL ;
**** @CHAQT
'DEBPROC' @CHAQT  MOD_1*MMODEL  MCH_1/MCHAML  CHP_1/CHPOINT MM_1/MOT   ;
* modification raph MITTEAU le 22 fevrier 1994 pour
* que CHAQT ne fasse rien en 3D

  MAI_1 = EXTR  MOD_1 'MAIL'  ;
SI (EGA (VALE DIME) 2) ;
  SI ( existe MM_1 )                   ;
   MM_11 = MM_1                        ;
  SINON                                ;
   MM_11 = 'MECANIQUE ELASTIQUE '            ;
  FINSI                                 ;
  SI ( existe MCH_1 )                   ;
*   M_21 = chan  'NOEUD' MOD_1 ( REDU MCH_1 MAI_1) ;
   M_21 = chan  'NOEUD' MOD_1 ( REDU MCH_1 MOD_1) ;
   CHP_21  = chan 'CHPO' MOD_1  M_21                 ;
  FINSI                                    ;
  SI ( existe CHP_1  )                   ;
   CHP_21 = (REDU CHP_1 MAI_1)               ;
   M_21 = chan CHAM CHP_21  MOD_1  'NOEUD' ;
  FINSI                                    ;
  SI ((NON ( existe CHP_1  )) ET (NON ( existe MCH_1)))      ;
   ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  FINSI                                    ;
*  MAI_2 = chan tri6 MAI_1       ;
  n_t6 = MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  n_q8  =  MAXI (nbel MAI_1 ( MOTS QUA8));
*  MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6        ;
  SI ( n_q8 > 0 )                ;
   MAI_Q8 = MAI_1 ELEM QUA8      ;
   SI ( n_t6 > 0 )                ;
    MAI_T6 = MAI_1 ELEM TRI6      ;
    MAI_2 =  (chan tri6 MAI_Q8) ET MAI_T6       ;
   SINON                                       ;
    MAI_2 =  chan tri6 MAI_Q8                  ;
   FINSI                                       ;
*  MOD_2 = modl MAI_2  mecanique elastique ;
   TT_1 = TEXTE  MM_11    ;
   MOD_2 = modl MAI_2  TT_1 ;
*  il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
   POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1  MAI_2 );
   CHP_22  = @ET CHP_21  ( proi POI_NEW M_21 ) ;
  SINON    ;
   MAI_2  = MAI_1 ;
   CHP_22 = CHP_21    ;
   MOD_2   = MOD_1    ;
  FINSI           ;
  m_22 = chan cham CHP_22 MOD_2  ;
SINON;
 m_22  = REDU  MCH_1 MOD_1 ;
 MOD_2 = MOD_1;
 MAI_2 = MAI_1 ;
FINSI ;

'FINPROC' m_22 MOD_2 MAI_2                    ;


*----------------------------------------------------------------------*
*                                                                      *
*                             C H A Q T                                *
*                             ---------                                *
*                                                       DATE 93/05/07
*  procedure   CHAQT (DRFC - J. Schlosser)
* ------------------------------------------
*
*    MCHPO2  MAIL2 = CHAQT3D  MOD1 OBJET1   MAIL1
*
*
*
*   Objet :
*  _________
*
*  Etant donne un objet  de type MCHAML ou CHPOINT , OBJET1,
*    defini sur un MMODEL massif,MOD1,compose de QUA8 et TRI6 (ou
*    en 3D de CU20 PR15) et un sous ensemble MAIL1 du maillage MAITOT1
*    correspondant a MOD1 ( en 3D par exemple
*    l enveloppe) compose de QUA8 et TRI6. La procedure cree
*     un CHPOINT defini sur un nouveau maillage compose exclusivement
*    de TRI6 afin de pouvoir effectue un trace  d isovaleur plus correct
*    ( le QUA8 initial se trouve ainsi transforme en QUA9 avec un point
*    milieu ce qui permet un decoupage en 8 triangles lineaires. Cela
*    revient a approximer la variation quadratique dans l element par
*    une variation bilineaire)
*
*                                                                      *
*  Commentaire
* _____________
*
*
*    MOD1   : objet de type MODL (elements massifs)
*
*    OBJET1 : objet de type  MCHAML ou CHPOINT
*
*    MAIL1  : objet de type MAILLAGE compose de TRI6 et de QUA8
*
*    MCHPO2   : objet de type  CHPOINT
*
*    MAIL2  : objet de type MAILLAGE compose de TRI6
*
*
*
*                                                                       *
*  Remarque
* _____________
*
*
*  la procedure utilise grosso modo
*          MAIL2 = chan tri6 MAIL1  ;
*         MCHPO2 =proi MAIL2 MCHPO1  ;
*  ce shema brut  est optimisee et la procedure  ne
*  fait la projection que sur les points nouveaux milieux des QUA8
*  ( malheureusement PROI ne calcule pas dans ce cas les bonnnes valeurs)
*
* Attention on voit que l on passe par l intermediaire d un CHPOINT
* les valeurs vont se trouver moyennees aux interfaces des materiaux
* si vous le souhaitez, procedez materiau par materiau !
* l' OBJET1 est REDUIT a MOD_1 a l entree de la procedure
*----------------------------------------------------------------------*
*123456789012345678901234567890123456789012345678901234567890123456789012
*         1         2         3         4         5         6         7
'DEBPROC' CHAQT3D   MOD_1*MMODEL  MCH_1/MCHAML  CHP_1/CHPOINT
                                               MAI_1*MAILLAGE   ;
  MAITOT1 = EXTR  MOD_1 'MAIL'  ;
  SI ( existe MCH_1 )                   ;
   M_21    =   REDU MCH_1  MOD_1        ;
   M_21    = chan  'NOEUD' MOD_1 M_21 ;
   CHP_21  = chan 'CHPO' MOD_1  M_21                 ;
   CHP_20  = REDU CHP_21 MAI_1               ;
  FINSI                                    ;
  SI ( existe CHP_1  )                   ;
   CHP_20  = REDU CHP_1 MAI_1               ;
   CHP_21  =  REDU CHP_1  MAITOT1           ;
   M_21    = chan CHAM  CHP_21   MOD_1  'NOEUD' ;
*   M_21    = chan CHAM  CHP_21   MOD_1  'STRESSES' ;
  FINSI                                    ;
  SI ((NON ( existe CHP_1  )) ET (NON ( existe MCH_1)))      ;
   ERRE 'IL FAUT DONNER UN CHPOINT OU UN MCHAML' ;
  FINSI                                    ;
*
  n_t6    =  MAXI (nbel MAI_1 ( MOTS TRI6)) ;
  n_q8    =  MAXI (nbel MAI_1 ( MOTS QUA8));
  MESS 'nbre de Q8:' n_q8 'nbre de TRI6:' n_t6        ;
  SI ( n_q8 > 0 )                ;
   MAI_Q8 = MAI_1 ELEM QUA8      ;
   SI ( n_t6 > 0 )                ;
    MAI_T6 = MAI_1 ELEM TRI6      ;
    MAI_2 = (chan tri6 MAI_Q8) ET MAI_T6       ;
   SINON                                       ;
    MAI_2 =  chan tri6 MAI_Q8                  ;
   FINSI                                       ;

*  il faut utiliser diff pour ne faire le proi que sur les noeuds nouveaux
   POI_NEW = DIFF ( CHAN POI1 MAI_1 ) ( CHAN POI1  MAI_2 );
*   trac  ( 1.e5 5.e4  -1.e5 ) CHP_20 MAI_1 ;
*   trac  ( 1.e5 5.e4  -1.e5 ) M_21 MOD_1 MAI_1 ;
*   trac  ( 1.e5 5.e4  -1.e5 ) ( MAI_1 et POI_NEW );
*   trac face   ( 1.e5 5.e4  -1.e5 ) MAI_2 ;
   CHP_22  = CHP_20 ET ( proi POI_NEW M_21 ) ;
*   trac  ( 1.e5 5.e4  -1.e5 ) CHP_22 MAI_2 ;

  SINON    ;
   MAI_2  = MAI_1 ;
   CHP_22 = CHP_21    ;
  FINSI           ;
'FINPROC' CHP_22  MAI_2                    ;

******************************************
*                                        *
* procedure CHREP : changement de repere *
*                                        *
******************************************
DEBPROC CHREP CHOIX*MOT CH_2/CHPOINT CH_M/MCHAML
              CH_PP2/CHPOINT CH_MP/MCHAML ;
MESS '----------------------> entree dans CHREP ';
SI ( EXISTE CH_2);
 CH_1 = CH_2      ;
 CH_PP = CH_PP2  ;
SINON ;
 CH_1 = CH_M     ;
 CH_PP = CH_MP;
FINSI;

V1 = VALEUR DIME ;
MESS'DIMENSION';
V2 = VALEUR MODE ;
P = TABLE         ;
P.1 = TABLE         ;
P.2 = TABLE         ;
P.3 = TABLE         ;
S = TABLE         ;
S.1 = TABLE         ;
S.2 = TABLE         ;
S.3 = TABLE         ;
SP = TABLE         ;
SP.1 = TABLE         ;
SP.2 = TABLE         ;
SP.3 = TABLE         ;

 LISTCOM1 = EXTR CH_1 'COMP';
 LISTCOM2 = EXTR CH_PP 'COMP';

 MR2D_1 = CHAINE 'TX  '  'TY  ' 'NX  ' 'NY  ' ;
 MR2D_2 = CHAINE 'P11 '  'P12 ' 'P21 ' 'P22 ' ;
 MR3D_1 = CHAINE 'TX  '  'TY  ' 'TZ  ' 'NX  ' 'NY  '
                         'NZ  ' 'BX  ' 'BY  ' 'BZ  ';
 MR3D_2 = CHAINE 'P11 ' 'P12 ' 'P13 ' 'P21 ' 'P22 ' 'P23 '
                                      'P31 ' 'P32 ' 'P33 ' ;
 SI ( EGA CHOIX 'CONTRAINTES' )  ;
  MC2D_1 = CHAINE 'SMXX'  'SMYY'  'SMZZ'   'SMXY' ;
  MC2D_2 = CHAINE 'SMRR'  'SMZZ'  'SMTT'   'SMRZ' ;
  MC3D_1 = CHAINE 'SMXX'  'SMYY'  'SMZZ'
                  'SMXY'  'SMXZ'  'SMYZ' ;
 FINSI ;
 SI ( EGA CHOIX 'DEFORMATIONS' )  ;
  MC2D_1 = CHAINE 'EPXX'  'EPYY'  'EPZZ'   'EPXY' ;
  MC2D_2 = CHAINE 'EPRR'  'EPZZ'  'EPTT'   'EPRZ' ;
  MC3D_1 = CHAINE 'EPXX'  'EPYY'  'EPZZ'
                  'EPXY'  'EPXZ'  'EPYZ' ;
 FINSI ;
SI  (V1 EGA 2) ;
 MCR1  =  CHAINE (EXTR LISTCOM2 1) (EXTR LISTCOM2 2)
                 (EXTR LISTCOM2 3) (EXTR LISTCOM2 4) ;
 MCC1  =  CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2)
                 (EXTR LISTCOM1 3) (EXTR LISTCOM1 4) ;
 MESS '>>>CHREP>>>' MCR1 ;
 MESS '>>>CHREP>>>' MR2D_1 ;
 SI ( NON (( EGA MCR1 MR2D_1) OU ( EGA MCR1 MR2D_2)) )  ;
  MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES  :' MCR1 ;
  MESS '>>>CHREP>>> AU LIEU DE                   :' MR2D_1 ;
  MESS '>>>CHREP>>> OU BIEN                      :' MR2D_2 ;
  ERREUR 'COMP_REP_NON_ADMISES'                        ;
 FINSI;
 SI ( NON (( EGA MCC1 MC2D_1) OU ( EGA MCC1 MC2D_2)) )  ;
  MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES  :' MCC1 ;
  MESS '>>>CHREP>>> AU LIEU DE                   :' MC2D_1 ;
  MESS '>>>CHREP>>> OU BIEN                      :' MC2D_2 ;
  ERREUR 'COMP_CHAMP_NON_ADMISES'                        ;
 FINSI;
FINSI;
SI  (V1 EGA 3) ;
 MCR1  =  CHAINE (EXTR LISTCOM2 1) (EXTR LISTCOM2 2)
                 (EXTR LISTCOM2 3) (EXTR LISTCOM2 4)
                 (EXTR LISTCOM2 5) (EXTR LISTCOM2 6)
                 (EXTR LISTCOM2 7) (EXTR LISTCOM2 8)
                                   (EXTR LISTCOM2 9) ;
 MCC1  =  CHAINE (EXTR LISTCOM1 1) (EXTR LISTCOM1 2)
                 (EXTR LISTCOM1 3) (EXTR LISTCOM1 4)
                 (EXTR LISTCOM1 5) (EXTR LISTCOM1 6) ;
 SI ( NON ( EGA MCR1 MR3D_1)  )  ;
  MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES  :' MCR1 ;
  MESS '>>>CHREP>>> AU LIEU DE                   :' MR3D_1 ;
  ERREUR 'COMP_REP_NON_ADMISES'                        ;
 FINSI;
 SI ( NON ( EGA MCC1 MC3D_1) )  ;
  MESS '>>>CHREP>>> COMPOSANTES REPERE TROUVEES  :' MCC1 ;
  MESS '>>>CHREP>>> AU LIEU DE                   :' MC3D_1 ;
  ERREUR 'COMP_CHAMP_NON_ADMISES'                        ;
 FINSI;
FINSI;

SI (V1 EGA 2);
 P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
 P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
 P.2 . 1 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
 P.2 . 2 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
 S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
 S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
 S.2 . 1 = S.1 . 2 ;
 S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
 S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
FINSI;
SI  (V1 > 2) ;
 P.1 . 1 = EXCO (EXTR LISTCOM2 1) CH_PP SCAL ;
 P.1 . 2 = EXCO (EXTR LISTCOM2 2) CH_PP SCAL ;
 P.1 . 3 = EXCO (EXTR LISTCOM2 3) CH_PP SCAL ;
 P.2 . 1 = EXCO (EXTR LISTCOM2 4) CH_PP SCAL ;
 P.2 . 2 = EXCO (EXTR LISTCOM2 5) CH_PP SCAL ;
 P.2 . 3 = EXCO (EXTR LISTCOM2 6) CH_PP SCAL ;
 P.3 . 1 = EXCO (EXTR LISTCOM2 7) CH_PP SCAL ;
 P.3 . 2 = EXCO (EXTR LISTCOM2 8) CH_PP SCAL ;
 P.3 . 3 = EXCO (EXTR LISTCOM2 9) CH_PP SCAL ;
*
 S.1 . 1 = EXCO (EXTR LISTCOM1 1) CH_1 SCAL ;
 S.1 . 2 = EXCO (EXTR LISTCOM1 4) CH_1 SCAL ;
 S.2 . 1 = S.1 . 2 ;
 S.2 . 2 = EXCO (EXTR LISTCOM1 2) CH_1 SCAL ;
 S.3 . 3 = EXCO (EXTR LISTCOM1 3) CH_1 SCAL ;
 S.1 . 3 = EXCO (EXTR LISTCOM1 5) CH_1 SCAL ;
 S.2 . 3 = EXCO (EXTR LISTCOM1 6) CH_1 SCAL ;
 S.3 . 1 = S.1 . 3 ;
 S.3 . 2 = S.2 . 3 ;

 I = 0;
 REPETER BOUCS1 3;
  I = I + 1;
  J = I - 1;
  REPETER BOUCS2 ( 3 + 1 - I );
   J = J + 1;
   SP.I.J = 0.;
   L = 0;
    REPETER BOUCS3 3;
     L = L + 1;
     Q = 0;
     REPETER BOUCS4 3;
      Q = Q + 1;
      SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
     FIN BOUCS4;
    FIN BOUCS3;
  FIN BOUCS2;
 FIN BOUCS1;
 SI ( EGA CHOIX CONTRAINTES);
  CH_2 = ( NOMC 'SMTT' SP.1 . 1 )  @ET
         ( NOMC 'SMNN' SP.2 . 2 )  @ET
         ( NOMC 'SMBB' SP.3 . 3 )  @ET
         ( NOMC 'SMTN' SP.1 . 2 )  @ET
         ( NOMC 'SMTB' SP.1 . 3 )  @ET
         ( NOMC 'SMNB' SP.2 . 3 );
 SINON;
  CH_2 = ( NOMC 'EPTT' SP.1 . 1 )  @ET
         ( NOMC 'EPNN' SP.2 . 2 )  @ET
         ( NOMC 'EPBB' SP.3 . 3 )  @ET
         ( NOMC 'EPTN' SP.1 . 2 )  @ET
         ( NOMC 'EPTB' SP.1 . 3 )  @ET
         ( NOMC 'EPNB' SP.2 . 3 );
 FINSI;

SINON;
 I = 0;
 REPETER BOUCS11 2;
  I = I + 1;
  J = I-1;
  REPETER BOUCS21 (2+1-I);
   J = J + 1;
   SP.I.J = 0. ;
   L = 0;
    REPETER BOUCS31 2;
     L = L + 1;
     Q = 0 ;
     REPETER BOUCS41 2;
      Q = Q + 1;
      SP.I.J = (SP.I.J) + ( (P.I.L) * ( P.J.Q) * (S.L.Q )) ;
     FIN BOUCS41;
    FIN BOUCS31;
  FIN BOUCS21;
 FIN BOUCS11;
 SP.3 . 3 = S.3 . 3;
 SI ( EGA CHOIX CONTRAINTES);
  CH_2 = ( NOMC 'SMTT' SP.1 . 1 )  @ET
         ( NOMC 'SMNN' SP.2 . 2 )  @ET
         ( NOMC 'SMBB' SP.3 . 3 )  @ET
         ( NOMC 'SMTN' SP.1 . 2 );
 SINON;
  CH_2 = ( NOMC 'EPTT' SP.1 . 1 )  @ET
         ( NOMC 'EPNN' SP.2 . 2 )  @ET
         ( NOMC 'EPBB' SP.3 . 3 )  @ET
         ( NOMC 'EPTN' SP.1 . 2 );
 FINSI;

FINSI;
MESS '----------------------> sortie  de  CHREP ';
FINPROC  CH_2;
**** @CLAMQ
DEBPROC @CLAMQ TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT
               ISHIFT*LOGIQUE IRIPPLE*LOGIQUE ;
*
***********************************************************
* Procedure de calcul du parametre Lambdaq necessaire au  *
* calcul du profil du depot de puissance en chaque point  *
* de la surface de la structure modelisee.                *
*             Alain MOAL (juin 1995)                      *
***********************************************************
*
MESS '---------------------------------> calling @CLAMQ';
*
*--------------- VARIABLES D'ENTREE :
RP       =  TAB1.<RP       ;
HP       =  TAB1.<HP       ;
RHO0     =  TAB1.<RHO0     ;
THETA0   =  TAB1.<THETA0   ;
ANGPHI0  =  TAB1.<ANGPHI0  ;
RR       =  TAB1.<RR       ;
LAMB     =  TAB1.<LAMB     ;
LAMBQREF =  TAB1.<LAMBQREF ;
THETAREF =  TAB1.<THETAREF ;
IPLASMA  =  TAB1.<IPLASMA  ;
COEFA    =  TAB1.<COEFA    ;
COEFB    =  TAB1.<COEFB    ;
COEFC    =  TAB1.<COEFC    ;
RHOMER   =  TAB1.<RHOMER   ;
NBOB     =  TAB1.<NBOB     ;
IMESS    =  TAB1.<IMESS    ;
*------------------------------------
*
PI  = 3.141592   ;
MU0 = 4.E-7 * PI ;
*
*---- Coordonnees de chaque point dans le repere du plasma
RHOP THETAP PHIP = @CRGTC XM YM ZM RP HP ;
*
*---- Masque delimitant le domaine de validite du modele de ripple
*attention domaine de validite etendu a 180 par E.COSTA et
*E.TSITRONE le 02/06/97
*MASK0 = (ABS THETAP) MASQUE INFERIEUR 110. ;
MASK0 = (ABS THETAP) MASQUE INFERIEUR 180. ;
*
SI ISHIFT ;
   AUX0 = -1. * MU0 * IPLASMA / (2. * PI) ;
*
   BPTHEREF = (((RHOP/RP) * (COS THETAREF) * LAMB) + 1.) * AUX0 ;
   BPTHE = (((COS THETAP) * (RHOP/RP) * LAMB) + 1.) * AUX0 ;
*
*  ---- facteur de compression des lignes de champ due au shift
   H1 = (RHOP * (COS THETAREF) + RP) * BPTHEREF ;
   H2 = ((COS THETAP) * RHOP + RP) * BPTHE ;
   HS = H2 ** -1 * H1 ;
SINON ;
   HS = RHOP * 0. + 1. ;
FINSI ;
*
SI IRIPPLE ;
*  ---- enveloppe de la DSMF dans le repere adapte au calcul du ripple
*  ---- Rho0 dans le "repere du ripple"
   RHOR THETAR PHIR = @CRGTC XM YM ZM RR 0. ;
*
   RHO0R = ((RHO0**2) + ((RP - RR)**2) +
           (2. * RHO0 * (RP - RR) * (COS THETAP)))**0.5 ;
   RHODSMFR = (EXP((THETAR**2) * -1. * COEFC)) *
             (EXP(COEFB * RHO0R)) *
             ((COS((PHIR + ANGPHI0) * NBOB)) - 1.) * COEFA + RHO0R;
*  ---- dans le repere du plasma
   RHODSMFP = RHODSMFR * 2. * (RR - RP) * (COS THETAR) ;
   RHODSMFP = RHODSMFP + ((RR - RP)**2) + (RHODSMFR**2) ;
   RHODSMFP = RHODSMFP**0.5 ;
   RHOMERP = RHOMER * 2. * (RR - RP) * (COS THETAR) ;
   RHOMERP = RHOMERP + ((RR - RP)**2) + (RHOMER**2) ;
   RHOMERP = RHOMERP**0.5 ;
*
*  ---- facteur de compression des lignes de champ due au ripple
*  ---- Rem : le masque sert a traiter le cas Rhomer = Rho0r
*  ---- dans le repere du ripple
*AM1**   MASQ1 = ((ABS(RHOR - RHODSMFR)) MASQUE INFERIEUR 1.E-6)*1.E-6;
*AM1**   MASQ2 = ((ABS(RHOMER - RHO0R)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
*AM1**   HR = ((RHOR - RHODSMFR) + MASQ1) / ((RHOMER - RHO0R)  + MASQ2) ;
*  ---- dans le repere du plasma
*AM2**   MASQ1 = ((ABS(RHOP - RHODSMFP)) MASQUE INFERIEUR 1.E-6)*1.E-6;
*AM2**   MASQ2 = ((ABS(RHOMERP - RHO0)) MASQUE INFERIEUR 1.E-6)*1.E-6 ;
*AM2**   HR = ((RHOP - RHODSMFP) + MASQ1) / ((RHOMERP - RHO0)  + MASQ2);
*AM***   HR = MASK0 * HR + ((1.-MASK0) * 1.) ;
*  ---- Pas de compression des lignes de champ due au ripple
   HR = RHOP * 0. + 1. ;
SINON ;
   HR = RHOP * 0. + 1. ;
FINSI ;
*
LAMBQ = HR * HS * LAMBQREF ;
*
*---- distance a la derniere surface magnetique avec ripple
SI IRIPPLE ;
*  ---- dans le repere du plasma
   DELTA = MASK0 * (RHOP - RHODSMFP) + ((1.-MASK0) * (RHOP - RHO0));
*  ---- dans le repere du ripple
*AM1**   DELTA =  MASK0 * (RHOR - RHODSMFR) + ((1.-MASK0) * (RHOR - RHO0R));
SINON ;
   DELTA = RHOP - RHO0 ;
FINSI ;
*
*---- messages de verification
SI (IMESS >EG 3) ;
   MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
   MESS '>>>> in @CLAMQ : RHODSMFR '; LIST RHODSMFR ;
   MESS '>>>> in @CLAMQ : RHO0R '; LIST RHO0R ;
   MESS '>>>> in @CLAMQ : HR '; LIST HR ;
   MESS '>>>> in @CLAMQ : HS '; LIST HS ;
   MESS '>>>> in @CLAMQ : LAMBQ '; LIST LAMBQ ;
   MESS '>>>> in @CLAMQ : DELTA '; LIST DELTA ;
FINSI ;
*
SI (IMESS >EG 2) ;
   MESS '>>>> in @CLAMQ : max and min values of HR ';
   MESS (MAXI HR) (MINI HR) ;
   MESS '>>>> in @CLAMQ : max and min values of HS ';
   MESS (MAXI HS) (MINI HS) ;
   MESS '>>>> in @CLAMQ : max and min values of LAMBQ ';
   MESS (MAXI LAMBQ) (MINI LAMBQ) ;
   MESS '>>>> in @CLAMQ : max and min values of DELTA ';
   MESS (MAXI DELTA) (MINI DELTA) ;
FINSI ;
*
MESS '---------------------------------> exiting @CLAMQ';
FINPROC LAMBQ HS HR DELTA ;




**** @CLIGB
DEBPROC @CLIGB NBPAS0*ENTIER PASB0*FLOTTANT TAB1*TABLE
               TABLIG1*TABLE IMETHOD*ENTIER;
*
*****************************************************************
* Procedure de calcul des lignes de champ magnetique partant de *
* chaque point d'une geometrie donnee.                          *
* methode 1 : methode explicite (tangentes)                     *
* methode 2 : Methode iterative avec convergence sur un critere *
*             d'appartenance a la surface magnetique            *
*                   Alain MOAL (mars 1996)                      *
*****************************************************************
*
MESS '---------------------------------> calling @CLIGB';
*
* ---- Valeurs par defaut
@VDEFAUT TAB1 ;
*
*--------------- VARIABLES D'ENTREE :
LISTE0  = TAB1.<LI_LIGNE_B ;
TYPCAL  = TAB1.<TYPE_CALCUL ;
RP      = TAB1.<RP ;
RR      = TAB1.<RR ;
HP      = TAB1.<HP ;
EPS0    = TAB1.<EPS ;
COEFA   = TAB1.<COEFA ;
COEFB   = TAB1.<COEFB ;
COEFC   = TAB1.<COEFC ;
NBOB    = TAB1.<NBOB  ;
SI (EXISTE TAB1 <LPT) ;
   RHO0    = TAB1.<RHO0 ;
FINSI ;
*------------------------------------
*
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;

SI (IMETHOD EGA 1) ;
*  ---- Methode explicite simple (tangentes)
   I0 = 0 ;

   REPETER BOUCLE0 (DIME LISTE0);

      I0 = I0 + 1 ; list I0 ;
      P0 = TEXT (EXTR I0 LISTE0) ;
      XM YM ZM = COOR P0 ;
      TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;

*     ---- Transformation en champ par point
      XM0 = MANU CHPO P0 1 SCAL XM ;
      YM0 = MANU CHPO P0 1 SCAL YM ;
      ZM0 = MANU CHPO P0 1 SCAL ZM ;

*     ---- Coordonnees dans le repere global du tore
      XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
*
      I1 = 0 ;
      REPETER BOUCLE1 NBPAS0 ;
*         I1 = I1 + 1 ; MESS 'I1 = ' I1;
*        ---- Calcul du champ dans le repere global
         BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD
                                 ZG_OLD ISHIFT IRIPPLE ;

         NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;

         XG_NEW = XG_OLD - (BXG * PASB0 / NORM_B) ;
         YG_NEW = YG_OLD - (BYG * PASB0 / NORM_B) ;
         ZG_NEW = ZG_OLD - (BZG * PASB0 / NORM_B) ;

*        ---- Coordonnees dans le repere du maillage
         XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW
                                       ZG_NEW TAB1 ;

         XM1 = EXTR XM_NEW SCAL P0 ;
         YM1 = EXTR YM_NEW SCAL P0 ;
         ZM1 = EXTR ZM_NEW SCAL P0;

         SI (EXISTE TAB1 <LPT) ;
*           ---- traitement particulier pour le LPT
*           ---- on change la couleur de la ligne qui
*           ---- passe au dessous
            XM2 YM2 ZM2 = @CRGMC XG_OLD YG_OLD ZG_OLD TAB1;

            SI ((ZG_NEW >EG RHO0) ET (ZG_OLD >EG RHO0)) ;
               TABLIG1.I0 = TABLIG1.I0 ET
               (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL ROUG);
            SINON ;
               TABLIG1.I0 = TABLIG1.I0 ET
               (((XM2 YM2 ZM2) D 1 (XM1 YM1 ZM1)) COUL JAUN);
            FINSI ;
         FINSI ;

         TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;

         XG_OLD = XG_NEW ;
         YG_OLD = YG_NEW ;
         ZG_OLD = ZG_NEW ;

         MENAGE ;

      FIN BOUCLE1 ;

*     ---- calcul de l'erreur sur Rho

      SI ((NON ISHIFT) ET (NON IRIPPLE)) ;
*        ---- Coordonnees du point initial dans le repere
*        ---- global du tore
         XG0 YG0 ZG0 = @CRMGC XM0 YM0 ZM0 TAB1 ;

*        ---- Coordonnees du point initial dans le repere
*        ---- pseudo-toroidal du plasma
         RHO0 THE0 PHI0 = @CRGTC XG0 YG0 ZG0 RP HP ;

*        ---- Coordonnees du point final dans le repere
*        ---- pseudo-toroidal du plasma
         RHO1 THE1 PHI1 = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP;

*        ---- sans ripple, on doit avoir Rho constant le
*        ---- long de la ligne de champ
         DRHO0 = RHO1 - RHO0 ;
         ERREUR0 = (ABS DRHO0) / RHO0 ;
         MESS 'Variation en Rho : ' ; LIST DRHO0 ;
         MESS 'Erreur en Rho : ' ; LIST ERREUR0 ;
      FINSI ;

   FIN BOUCLE0 ;
FINSI ;

SI (IMETHOD EGA 2) ;
*  ---- Methode iterative avec convergence sur un critere
*  ---- d'appartenance a la surface magnetique
   I0 = 0 ;

   REPETER BOUCLE0 (DIME LISTE0);

      I0 = I0 + 1 ;
      P0 = TEXT (EXTR I0 LISTE0) ;
      XM YM ZM = COOR P0 ;
      TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;

*     ---- Transformation en champ par point
      XM0 = MANU CHPO P0 1 SCAL XM ;
      YM0 = MANU CHPO P0 1 SCAL YM ;
      ZM0 = MANU CHPO P0 1 SCAL ZM ;

*     ---- Coordonnees dans le repere global du tore
      XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
*
      I1 = 0 ;
      REPETER BOUCLE1 NBPAS0 ;

         I1 = I1 + 1 ; MESS 'I1 = ' I1;
*        ---- Calcul du champ dans le repere global
         BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD
                                 ZG_OLD ISHIFT IRIPPLE ;

         NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;

         XG_NEW0 = XG_OLD - (BXG * PASB0 / NORM_B) ;
         YG_NEW0 = YG_OLD - (BYG * PASB0 / NORM_B) ;
         ZG_NEW0 = ZG_OLD - (BZG * PASB0 / NORM_B) ;

*        ---- Coordonnees dans le repere
*        ---- pseudo-toroidal du ripple
         RHOR THER PHIR = @CRGTC XG_OLD YG_OLD ZG_OLD RR 0.;

*        ---- calcul de la coordonnee radiale dans le
*        ---- plan meridien Phi=0 de la ligne de champ
*        ---- consideree par une methode de point fixe
         RHOR_OLD = RHOR ;
         KAUX = (EXP(THER**2 * -1. * COEFC)) *
                ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
         I3 = 0 ;
         REPETER BOUCLE3 50 ;
            I3 = I3 + 1; MESS '      I3 = ' I3;
            RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
            SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD) /
                RHOR_NEW))) <EG EPS0) ;
                QUITTER BOUCLE3 ;
            FINSI ;
            RHOR_OLD = RHOR_NEW ;
         FIN BOUCLE3 ;

         RHOMER = RHOR_NEW ;

*        ---- le point obtenu doit etre sur la surface magnetique
         I2 = 0 ;
         REPETER BOUCLE2 2 ;
            I2 = I2 + 1 ; MESS '   I2 = ' I2;
*           ---- Coordonnees dans le repere
*           ---- pseudo-toroidal du ripple
            RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0
                                       ZG_NEW0 RR 0.;

            DRHOMERN = (EXP(RHOMER * COEFB)) * (EXP(THERN**2
                      * COEFC * -1.)) * COEFA ;

            RHORIP = DRHOMERN * ((COS (PHIRN*NBOB)) - 1.) + RHOMER;

*           ---- Coordonnees dans le repere global
            XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN
                                             PHIRN RR 0.;

*           ---- Calcul du champ dans le repere global
            BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1
                                    ZG_NEW1 ISHIFT IRIPPLE ;

*           ---- on prend la moyenne des 2 tangentes
            BXG1 = (BXG + BXG0)/2. ;
            BYG1 = (BYG + BYG0)/2. ;
            BZG1 = (BZG + BZG0)/2. ;

            NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1)
                       + (BZG1*BZG1))**0.5 ;

            XG_NEW0 = XG_OLD - (BXG1 * PASB0 / NORM_B1) ;
            YG_NEW0 = YG_OLD - (BYG1 * PASB0 / NORM_B1) ;
            ZG_NEW0 = ZG_OLD - (BZG1 * PASB0 / NORM_B1) ;

            SI (I2 EGA 2) ;
               XG_NEW = XG_NEW0 ;
               YG_NEW = YG_NEW0 ;
               ZG_NEW = ZG_NEW0 ;
            FINSI ;

         FIN BOUCLE2 ;

*        ---- Coordonnees dans le repere du maillage
         XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW
                                       ZG_NEW TAB1 ;

         XG_OLD = XG_NEW ;
         YG_OLD = YG_NEW ;
         ZG_OLD = ZG_NEW ;

         XM1 = EXTR XM_NEW SCAL P0 ;
         YM1 = EXTR YM_NEW SCAL P0 ;
         ZM1 = EXTR ZM_NEW SCAL P0;

         TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;
         MENAGE ;

      FIN BOUCLE1 ;
   FIN BOUCLE0 ;
FINSI ;
MESS '---------------------------------> exiting @CLIGB';
FINPROC ;

**** @CLIGB0
DEBPROC @CLIGB0 DPHI*FLOTTANT PHIMAX*FLOTTANT
               TAB1*TABLE TABLIG1*TABLE IMETHOD*ENTIER;
*
*****************************************************************
* Procedure de calcul des lignes de champ magnetique partant de *
* chaque point d'une geometrie donnee.                          *
* methode 1 : methode explicite (tangentes)                     *
* methode 2 : Runge-Kutta du 4eme ordre a pas constant          *
*                   Alain MOAL (mars 1996)                      *
*****************************************************************
*
MESS '---------------------------------> calling @CLIGB';
*
*--------------- VARIABLES D'ENTREE :
LISTE0  = TAB1.<LI_LIGNE_B ;
OEIL0   = TAB1.VIEW_P ;
RP      = TAB1.<RP     ;
HP      = TAB1.<HP     ;
ANGPHI0 = TAB1.<ANG_PHI0 ;
TYPCAL  = TAB1.<TYPE_CALCUL ;
*------------------------------------
*
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB0 : check the value of TAB1.<TYPE_CALCUL';
FINSI ;

* ---- Valeurs par defaut
@VDEFAUT TAB1 ;
TABLIG1 = TABLE ;
*
SI (IMETHOD EGA 1) ;
*  ---- Methode explicite (tangentes)
   TEMPS ZERO ;
   I0 = 0 ;
   REPETER BOUCLE0 (DIME LISTE0);

      I0 = I0 + 1 ;
      P0 = TEXT (EXTR I0 LISTE0) ;
      XM YM ZM = COOR P0 ;
      TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
*
*     ---- Transformation en champ par point
      XM0 = MANU CHPO P0 1 SCAL XM ;
      YM0 = MANU CHPO P0 1 SCAL YM ;
      ZM0 = MANU CHPO P0 1 SCAL ZM ;
      DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
*
*     ---- Coordonnees dans le repere global du tore
      XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
*
      LISTRHO = PROG ;
      LISTTHE = PROG ;
      LISTPHI = PROG ;
      LISTFSE = PROG ;
*
      PHIAUX = ANGPHI0 ;
*
      REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
*
         PHIAUX = PHIAUX + DPHI ;
*        ---- Numero du grand tour calcule a partir du plan
*        ---- median entre bobines
         NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
*
*        ---- Calcul du champ dans le repere global
         BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD
                                 ZG_OLD ISHIFT IRIPPLE ;
*
*        ---- Coordonnees dans le repere pseudo-toroidal du plasma
         RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD
                                          ZG_OLD RP HP ;
*
*        ---- Champ dans le repere pseudo-toroidal du plasma
         BRHO BTHETA BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
*
         DRHO0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO
                   * DPHI0 / BPHI;
         DTHE0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHETA
                  * DPHI0 / BPHI / RHO_OLD;

         RHO_NEW = RHO_OLD + DRHO0 ;
         THE_NEW = THE_OLD + DTHE0 ;
*         MESS 'PHI_OLD+DPHI0 '; LIST (MAXI (PHI_OLD+DPHI0));
         SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
            ((MAXI (PHI_OLD+DPHI0)) <EG 180.));
            PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
         FINSI ;
         SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
            ((MAXI (PHI_OLD+DPHI0)) < 0.));
            PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
         FINSI ;
         SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
            PHI_NEW = PHI_OLD + DPHI0 ;
         FINSI ;

         LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
         LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
         LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
         LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;
*
*        ---- Coordonnees dans le repere global
         XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW
                                       PHI_NEW RP HP;
*
         MESS 'TOUR : ' ; LIST NTOUR0 ;
         MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
         MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
         MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
         MESS 'MAX DE FSECU '; LIST (MAXI FSECU);

*         MESS 'MAX DE BPHI '; LIST (MAXI BPHI);
*         MESS 'MAX DE BRHO '; LIST (MAXI BRHO);
*         MESS 'MAX DE BTHE '; LIST (MAXI BTHETA);

*        ---- Coordonnees dans le repere du maillage
         XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW
                                       ZG_NEW TAB1 ;
*
         XG_OLD = XG_NEW ;
         YG_OLD = YG_NEW ;
         ZG_OLD = ZG_NEW ;

         XM1 = EXTR XM_NEW SCAL P0 ;
         YM1 = EXTR YM_NEW SCAL P0 ;
         ZM1 = EXTR ZM_NEW SCAL P0;

         TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;

         SI ((MAXI PHI_NEW) >EG PHIMAX) ;
            MESS '>>>> The maximum value of Phi is reached';
            QUITTER BOUCLE1 ;
         FINSI ;
         MENAGE ;

      FIN BOUCLE1 ;

      EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
      EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
      EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
      DESSIN EVRHO MIMA ;
      DESSIN EVTHE MIMA ;
      DESSIN EVFSE MIMA ;
   FIN BOUCLE0 ;
   TEMPS ;
FINSI ;

SI (IMETHOD EGA 2) ;
*  ---- Runge-Kutta d'ordre 4 a pas constant
   TEMPS ZERO ;
   I0 = 0 ;
   REPETER BOUCLE0 (DIME LISTE0);

      I0 = I0 + 1 ;
      P0 = TEXT (EXTR I0 LISTE0) ;
      XM YM ZM = COOR P0 ;
      TABLIG1.I0 = ((XM+1.E-6) YM ZM) D 1 P0 ;
*
*     ---- Transformation en champ par point
      XM0 = MANU CHPO P0 1 SCAL XM ;
      YM0 = MANU CHPO P0 1 SCAL YM ;
      ZM0 = MANU CHPO P0 1 SCAL ZM ;
      DPHI0 = MANU CHPO P0 1 SCAL DPHI ;
*
*     ---- Coordonnees dans le repere global du tore
      XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;
*
      LISTRHO = PROG ;
      LISTTHE = PROG ;
      LISTPHI = PROG ;
      LISTFSE = PROG ;
*
      PHIAUX = ANGPHI0 ;
*
      REPETER BOUCLE1 (ENTI (PHIMAX/DPHI)) ;
*
         PHIAUX = PHIAUX + DPHI ;
*        ---- Numero du grand tour calcule a partir du plan
*         ---- median entre bobine
         NTOUR0 = (ENTI (PHIAUX / 360.)) + 1 ;
*
*        ---- Calcul du champ dans le repere global
         BX BY BZ FSECU = @CHAMB TAB1 XG_OLD YG_OLD
                                 ZG_OLD ISHIFT IRIPPLE ;

*        ---- Coordonnees dans le repere pseudo-toroidal du plasma
         RHO_OLD THE_OLD PHI_OLD = @CRGTC XG_OLD YG_OLD
                                          ZG_OLD RP HP ;

*        ---- Champ dans le repere pseudo-toroidal du plasma
         BRHO BTHE BPHI = @CBGTV BX BY BZ THE_OLD PHI_OLD ;
*
*        ---- calcul de K0 et L0
         K0 = (RHO_OLD * (COS THE_OLD) + RP) * BRHO / BPHI;
         L0 = (RHO_OLD * (COS THE_OLD) + RP) * BTHE / BPHI
               / RHO_OLD;

*        ---- calcul de K1 et L1
         RHO1_OLD = RHO_OLD + (K0/2.) ;
         THE1_OLD = THE_OLD + (L0/2.) ;
*         SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
*            ((MAXI (PHI_OLD+DPHI0)) <EG 180.));
*            PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
*         FINSI ;
*        SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
*            ((MAXI (PHI_OLD+DPHI0)) < 0.));
*            PHI1_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0) ;
*         FINSI ;
*         SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
            PHI1_OLD = PHI_OLD + (DPHI0/2) ;
*         FINSI ;

         XG1_OLD YG1_OLD ZG1_OLD = @CRTGC RHO1_OLD THE1_OLD
                                          PHI1_OLD RP HP;

*        ---- Calcul du champ dans le repere global
         BX1 BY1 BZ1 FSECU = @CHAMB TAB1 XG1_OLD YG1_OLD
                                    ZG1_OLD IRIPPLE ISHIFT ;

*        ---- Champ dans le repere pseudo-toroidal du plasma
         BRHO1 BTHE1 BPHI1 = @CBGTV BX1 BY1 BZ1
                                      THE1_OLD PHI1_OLD ;

         K1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BRHO1
              /BPHI1 * DPHI0;
         L1 = (RHO1_OLD * (COS THE1_OLD) + RP)*BTHE1/BPHI1
               / RHO1_OLD * DPHI0;

*        ---- calcul de K2 et L2
         RHO2_OLD = RHO_OLD + (K1/2.) ;
         THE2_OLD = THE_OLD + (L1/2.) ;
*         SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
*            ((MAXI (PHI_OLD+DPHI0)) <EG 180.));
*            PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * (NTOUR0-1));
*         FINSI ;
*         SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
*            ((MAXI (PHI_OLD+DPHI0)) < 0.));
*            PHI2_OLD = PHI_OLD + (DPHI0/2.) + (360. * NTOUR0);
*         FINSI ;
*         SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
            PHI2_OLD = PHI_OLD + (DPHI0/2) ;
*         FINSI ;

         XG2_OLD YG2_OLD ZG2_OLD = @CRTGC RHO2_OLD THE2_OLD
                                          PHI2_OLD RP HP;

*        ---- Calcul du champ dans le repere global
         BX2 BY2 BZ2 FSECU = @CHAMB TAB1 XG2_OLD YG2_OLD
                                    ZG2_OLD ISHIFT IRIPPLE ;

*        ---- Champ dans le repere pseudo-toroidal du plasma
         BRHO2 BTHE2 BPHI2 = @CBGTV BX2 BY2 BZ2
                                    THE2_OLD PHI2_OLD ;

         K2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BRHO2
               /BPHI2 * DPHI0;
         L2 = (RHO2_OLD * (COS THE2_OLD) + RP)*BTHE2/BPHI2
               / RHO2_OLD * DPHI0;

*        ---- calcul de K3 et L3
         RHO3_OLD = RHO_OLD + K2 ;
         THE3_OLD = THE_OLD + L2 ;
*         SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
*            ((MAXI (PHI_OLD+DPHI0)) <EG 180.));
*            PHI3_OLD = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
*         FINSI ;
*         SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
*            ((MAXI (PHI_OLD+DPHI0)) < 0.));
*            PHI3_OLD = PHI_OLD + DPHI0 + (360. * NTOUR0);
*         FINSI ;
*         SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
            PHI3_OLD = PHI_OLD + DPHI0 ;
*         FINSI ;

         XG3_OLD YG3_OLD ZG3_OLD = @CRTGC RHO3_OLD THE3_OLD
                                          PHI3_OLD RP HP;

*        ---- Calcul du champ dans le repere global
         BX3 BY3 BZ3 FSECU = @CHAMB TAB1 XG3_OLD YG3_OLD
                                    ZG3_OLD ISHIFT IRIPPLE ;

*        ---- Champ dans le repere pseudo-toroidal du plasma
         BRHO3 BTHE3 BPHI3 = @CBGTV BX3 BY3 BZ3
                                    THE3_OLD PHI3_OLD ;

         K3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BRHO3
               / BPHI3 * DPHI0;
         L3 = (RHO3_OLD * (COS THE3_OLD) + RP)*BTHE3/BPHI3
               / RHO3_OLD * DPHI0;

         RHO_NEW = RHO_OLD + ((K0 + (2.*K1) + (2.*K2) + K3)/6.);
         THE_NEW = THE_OLD + ((L0 + (2.*L1) + (2.*L2) + L3)/6.);

         SI (((MAXI (PHI_OLD+DPHI0)) >EG 0.) ET
            ((MAXI (PHI_OLD+DPHI0)) <EG 180.));
            PHI_NEW = PHI_OLD + DPHI0 + (360. * (NTOUR0-1));
         FINSI ;
         SI (((MAXI (PHI_OLD+DPHI0)) > -180.) ET
            ((MAXI (PHI_OLD+DPHI0)) < 0.));
            PHI_NEW = PHI_OLD + DPHI0 + (360. * NTOUR0) ;
         FINSI ;
         SI ((MAXI (PHI_OLD+DPHI0)) > 180.) ;
            PHI_NEW = PHI_OLD + DPHI0 ;
         FINSI ;

         LISTRHO = LISTRHO ET (PROG (MAXI RHO_NEW)) ;
         LISTTHE = LISTTHE ET (PROG (MAXI THE_NEW)) ;
         LISTPHI = LISTPHI ET (PROG (MAXI PHI_NEW)) ;
         LISTFSE = LISTFSE ET (PROG (MAXI FSECU)) ;

*        ---- Coordonnees dans le repere global
         XG_NEW YG_NEW ZG_NEW = @CRTGC RHO_NEW THE_NEW
                                       PHI_NEW RP HP;
         MESS 'TOUR : ' ; LIST NTOUR0 ;
         MESS 'MAX DE PHI '; LIST (MAXI PHI_NEW);
         MESS 'MAX DE RHO '; LIST (MAXI RHO_NEW);
         MESS 'MAX DE THE '; LIST (MAXI THE_NEW);
         MESS 'MAX DE FSECU '; LIST (MAXI FSECU);

*        ---- Coordonnees dans le repere du maillage
         XM_NEW YM_NEW ZM_NEW = @CRGMC XG_NEW YG_NEW
                                       ZG_NEW TAB1 ;
*
         XG_OLD = XG_NEW ;
         YG_OLD = YG_NEW ;
         ZG_OLD = ZG_NEW ;

         XM1 = EXTR XM_NEW SCAL P0 ;
         YM1 = EXTR YM_NEW SCAL P0 ;
         ZM1 = EXTR ZM_NEW SCAL P0;

         TABLIG1.I0 = TABLIG1.I0 D 1 (XM1 YM1 ZM1) ;

         SI ((MAXI PHI_NEW) >EG PHIMAX) ;
            MESS '>>>> The maximum value of Phi is reached';
            QUITTER BOUCLE1 ;
         FINSI ;
         MENAGE ;

      FIN BOUCLE1 ;

      EVRHO = EVOL JAUN MANU 'PHI' LISTPHI 'RHO' LISTRHO ;
      EVTHE = EVOL ROUG MANU 'PHI' LISTPHI 'THETA' LISTTHE ;
      EVFSE = EVOL VERT MANU 'PHI' LISTPHI 'FSECU' LISTFSE ;
      DESSIN EVRHO MIMA ;
      DESSIN EVTHE MIMA ;
      DESSIN EVFSE MIMA ;
   FIN BOUCLE0 ;
   TEMPS ;
FINSI ;

MESS '---------------------------------> exiting @CLIGB0';
FINPROC  ;

**** CONTACT
*---------------------------------------------------------------------
*             PROCEDURE CONTACT   VERSION DU 15/10/87
*---------------------------------------------------------------------
*   CETTE PROCEDURE SERT A DEFINIR LE CONTACT ENTRE 2 SOLIDES
*   OU ENTRE 1 SOLIDE ET UN OBSTACLE .
*
*   SYNTAXE :
*   -------
*
*
*   BLC BLT  FFF COEF  =
*
*        CONTACT | MINI | NOMINC       | POI1 ( POI2 ) |
*                | MAXI | DIRECTION V1 | GEO1 ( GEO2 ) |
*
*                | CONSTANT |  MU    ( JEU  | VVAL  |  )   ;
*                | COULOMB  |               | CHSCA |
*                                           | CHP   |
*
*
*   ATTENTION  METTRE LES NOMS CONNUS EN 4 LETTRES |
*    EXEMPLE  : METTRE DIRE ET NON PAS DIRECTION
*
*     ( EXPLICATION : CF BLOQUER , RELA ET DEPI )
*
*      BLC ET BLT: LES BLOCAGES ASSOCIES AU CONTACT
*                  ( NORMAUX ET TANGENTIELS )
*      FFF       : LE SECOND MEMBRE ( NON NUL SI JEU )
*      COEF      : LES COEFFICIENTS DE FROTTEMENT
*
*---------------------------------------------------------------------
      DEBPROC CONTACT MOMIN*MOT DDL*MOT V1/POINT
      POI1/POINT POI2/POINT MA1/MAILLAGE MA2/MAILLAGE
      MFRO*MOT  ZFRO*FLOTTANT
      MJEU/MOT  VVAL/FLOTTANT VCHP/CHPOINT   ;
*
IDIR = 0 ;
SSDIM = VALE DIME ;
SI ( EGA DDL DIRE ) ;
IDIR = 1 ;  FINSI ;
*------------------------------
*  ON RECUPERE LA GEOMETRIE
*------------------------------
IDEUX = 0 ;
SI ( EGA IDIR 0 ) ;
  SI ( EXISTE V1 ) ;
  GEO1 = V1 ;
    SI ( EXISTE POI1 ) ;
    IDEUX = 1 ;
    GEO2 = POI1 ;
    FINSI ;
  FINSI ;
SINON ;
  SI ( EXISTE POI1 ) ;
  GEO1 = POI1 ;
    SI ( EXISTE POI2 ) ;
    IDEUX = 1 ;
    GEO2 = POI2 ;
    FINSI ;
  FINSI;
FINSI ;
SI ( EXISTE MA1 ) ;
GEO1 = MA1 ;
FINSI ;
SI ( EXISTE MA2 ) ;
IDEUX = 1 ;
GEO2 = MA2 ;
FINSI ;
SI ( EGA IDEUX 1 ) ;
GEO = GEO1 ET GEO2 ; SINON ;
GEO = GEO1 ;
FINSI ;
*
*------------------------------
*  ON RECUPERE LA DIRECTION
*------------------------------
SI ( EGA IDIR 1 ) ;
IDIR = 1 ;
SI ( EGA SSDIM 2 ) ;
V1X V1Y = COOR V1 ;
V2 =  V1Y  ( 0 - V1X ) ;
SINON ;
V1X V1Y V1Z = COOR V1 ;
V2X = 0. - V1Y ;
V2Y = V1X ;
V2Z = 0. ;
V2 = V2X V2Y V2Z ;
V2NOR = NORM V2 ;
SI ( EGA V2NOR 0. ) ;
V2 = 0. ( 0. - V1Z ) V1Y ;
FINSI ;
V3 = PVECT V1 V2 ;
FINSI ;
SINON ;
SI ( EGA DDL UX ) ;
SI ( EGA SSDIM 2 ) ;
V1 = 1 0 ;
V2 = 0 -1 ;
SINON ;
V1 = 1 0 0 ;
V2 = 0 1 0 ;
V3 = 0 0 1 ;
FINSI ;
FINSI ;
SI ( EGA DDL UY ) ;
SI ( EGA SSDIM 2 ) ;
V1 = 0 1 ;
V2 = 1 0 ;
SINON ;
V1 = 0 1 0 ;
V2 = 0 0 1;
V3 = 1 0 0 ;
FINSI ;
FINSI ;
SI ( EGA DDL UR ) ;
V1 = 1 0 ;
V2 = 0 1 ;
FINSI ;
SI ( EGA DDL UZ ) ;
SI ( EGA SSDIM 2 ) ;
V1 = 0 1 ;
V2 = 1 0 ;
SINON ;
V1 = 0 0 1 ;
V2 = 1 0 0;
V3 = 0 1 0 ;
FINSI ;
FINSI ;
FINSI ;
*-----------------------
*  ON RECUPERE LE JEU
*-----------------------
IJEU = 0 ;
SI ( EXISTE MJEU ) ;
IJEU = 1 ;
SI ( EXISTE VVAL ) ;
VJEU = VVAL ;
FINSI ;
SI ( EXISTE VCHP ) ;
VJEU = VCHP ;
FINSI ;
FINSI ;
*--------------------------
*  ON CREE LES BLOCAGES
*--------------------------
*
SI ( EGA IDEUX 0 ) ;
BLC = BLOQUE MOMIN DEPL DIRECTION V1 GEO1 ;
BLT = BLOQUE FROT  DEPL DIRECTION V2 GEO1 ;
SI ( EGA SSDIM 3 ) ;
BLT = BLT ET ( BLOQUE FROT  DEPL DIRECTION V3 GEO1 ) ;
FINSI ;
SINON ;
BLC = RELA   MOMIN DEPL DIREC V1 GEO1 - DEPL DIREC V1 GEO2 ;
BLT = RELA   FROT  DEPL DIREC V2 GEO1 - DEPL DIREC V2 GEO2 ;
SI ( EGA SSDIM 3 ) ;
BLT = BLT ET
  ( RELA   FROT  DEPL DIREC V3 GEO1 - DEPL DIREC V3 GEO2 ) ;
FINSI ;
FINSI ;
*BLOCAG = BLC ET BLT ;
*-------------------------------------------
*  ON CALCULE LES FORCES AU SECOND MEMBRE
*-------------------------------------------
SI ( EGA IJEU 1 ) ;
SI ( EGA MOMIN MAXI ) ;
FAC = 1.;
SINON ;
FAC = -1. ;
FINSI ;
FFF = DEPI  BLC ( FAC * VJEU ) ;
SINON ;
FFF = MANU CHPO GEO 1 FLX 0. ;
FINSI ;
*---------------------------------------------
*  ON CALCULE LES COEFFICIENTS DE FROTTEMENT
*---------------------------------------------
   GEOT = EXTR BLT MAIL MULT ;
   COEF = MANU CHPO GEOT 1 MFRO ZFRO ;
*----------------------------------------------------------------------
*                    SORTIE DE LA PROCEDURE
*----------------------------------------------------------------------
FINPROC BLC BLT  FFF COEF ;
*         1         2         3         4         5         6          7*
*123456789012345678901234567890123456789012345678901234567890123456789012
*                                                                       *
*                                                                       *
*                                                                       *
DEBPROC CONTRAPH    LIGN_1*MAILLAGE
                  INSTEVOL*FLOTTANT
                      MOD1*MMODEL
                      TAB1*TABLE
                       SM1/EVOLUTION
                       SM2/EVOLUTION
                      VAL1/FLOTTANT;

MESS '-----------------------------------> entree dans CONTRAPH '    ;

DIM1 = VALEUR DIME                                                   ;
* test sur la dimension
SI (EGA DIM1 2)                                                      ;
 MESS ' attention au SMZZ  en 2D'                                    ;
SINON ;
 MESS ' !!! ATTENTION !!! en 3 D '                                   ;
 MESS ' utilisation a vos risques et perils a cause du fonctionement
   incertain de PROI '                                              ;
 MESS ' la remarque est sans objet si LIGN_1 appartient au maillage ';
FINSI;


SI (NON (EXISTE TAB1 RESUCONT))                                      ;
 MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES '                        ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

* test sur la dimension de LIGN_1*MAILLAGE : a faire

LCONFON = FAUX                                                       ;
MAIL_1 =  MOD1  EXTR 'MAIL'                                          ;
N_1 = NBNO  MAIL_1                                                   ;
N_2 = NBNO (MAIL_1 ET LIGN_1  )                                      ;

SI ( EGA N_1 N_2 )                                                   ;
 LCONFON = VRAI                                                      ;
FINSI                                                                ;

SI (NON(EXISTE TAB1 TETMAT))                                         ;
 MESS ' TAB1 NE CONTIENT PAS DE TETMAT '                             ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

SI (NON(EXISTE (TAB1.TETMAT) MOD1))                                  ;
 MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE '                      ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY))                             ;
 MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE '                    ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

L1TITR   = CHAIN 'DEPOUILLEMENT LE LONG DE LA LIGNE A' INSTEVOL      ;
TITR L1TITR                                                          ;

LIMELAS1 = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY'      ;

SI (EXISTE SM1)                                                      ;
 LIMSM1  = VARI TAB1.CHPOTHETA.INSTEVOL SM1                          ;
FINSI                                                                ;
SI (EXISTE SM2)                                                      ;
 LIMSM2  = VARI TAB1.CHPOTHETA.INSTEVOL SM2                          ;
FINSI                                                                ;
VMIS1    = VMIS MOD1 TAB1.RESUCONT. INSTEVOL                         ;

CHEP4 = EXCO  TAB1.RESUVARI.INSTEVOL EPSE ;
CHEP3 = REDU CHEP4 MOD1 ;
CHEP2 = (CHAN NOEUD CHEP3 MOD1 );

SI  LCONFON                                                          ;
 CHVM1    = CHAN 'CHPO' MOD1 (CHAN NOEUD MOD1 VMIS1)                 ;
 LIMELAS2 = LIMELAS1                                                 ;
 CHEP1    = CHAN 'CHPO' MOD1 CHEP2                                   ;
 SI (EXISTE SM1 )                                                    ;
  LIM2SM1 = LIMSM1                                 ;
 FINSI                                                               ;
 SI (EXISTE SM2 )                                                    ;
  LIM2SM2 = LIMSM2                                 ;
 FINSI                                                               ;
SINON                                                                ;
 CHVM1    = PROI LIGN_1 (CHAN NOEUD MOD1 VMIS1)                      ;
 LIMELAS2 = PROI LIGN_1 (CHAN CHAM LIMELAS1 MOD1 NOEUD)              ;
 CHEP1    = PROI LIGN_1 CHEP2                                        ;
 SI (EXISTE SM1)                                                     ;
  LIM2SM1 = PROI LIGN_1 (CHAN CHAM LIMSM1 MOD1 NOEUD)                ;
 FINSI                                                               ;
 SI (EXISTE SM2)                                                     ;
  LIM2SM2 = PROI LIGN_1 (CHAN CHAM LIMSM2 MOD1 NOEUD)                ;
 FINSI                                                               ;
FINSI                                                                ;

TAC1   = TABLE ;
EVVM1   = EVOL ROUG CHPO CHVM1     LIGN_1                            ;
EVEL1   = EVOL BLEU CHPO LIMELAS2  LIGN_1                            ;
* champs dde  t le long de la ligne
TCHAM   = CHAN CHAM (TAB1.CHPOTHETA.INSTEVOL) MOD1 NOEUD             ;
PTCH    = PROI TCHAM LIGN_1                                          ;
EVTE1   = EVOL JAUN CHPO (PTCH * 1.E6) 'T' LIGN_1                    ;
TAC1.1  = CHAI 'MARQ CARR REGU TITR V_MISES '                        ;
TAC1.3  = CHAI 'MARQ LOSA REGU TITR LIM_ELAS'                        ;
TAC1.5  = CHAI 'MARQ CROI REGU TITR TEMPERAT'                        ;
EV_OTT =  EVVM1 ET EVEL1 ET EVTE1                                    ;

SI (EXISTE SM1)                                                      ;
   EVRU1   = EVOL TURQ CHPO LIM2SM1 LIGN_1                           ;
   TAC1.7  = CHAI 'MARQ TRIA REGU TITR SM'                           ;
   SI (EXISTE SM2)                                                   ;
     EVRU2   = EVOL VERT CHPO LIM2SM2 LIGN_1                         ;
     TAC1.9  = CHAI 'MARQ TRIB REGU TITR 3SM_ou_RM'                  ;
     SI (EXISTE VAL1)                                               ;
       EVVA1   =  EVOL CHPO VAL1  LIGN_1                             ;
       TAC1.11 = CHAI 'MARQ ETOI REGU TITR VALEUR'                   ;
       EV_OTT  =  EV_OTT ET EVRU1 ET EVRU2 ET EVVA1                  ;
     SINON                                                           ;
       EV_OTT  =  EV_OTT ET EVRU1 ET EVRU2                           ;
     FINSI                                                           ;
  SINON                                                             ;
     SI (EXISTE VAL1)                                                ;
        EVVA1   =  EVOL CHPO VAL1  LIGN_1                            ;
        TAC1.9 = CHAI 'MARQ ETOI REGU TITR VALEUR'                   ;
         EV_OTT  =  EV_OTT ET EVRU1 ET EVVA1                         ;
    FINSI                                                            ;
*tc ajout d'un finsi ???
  'FINSI'                                                            ;
SINON                                                                ;
  SI (EXISTE VAL1 )                                                   ;
    EVVA1  =  EVOL CHPO VAL1  LIGN_1                                   ;
    TAC1.7 = CHAI 'MARQ ETOI REGU TITR VALEUR'                         ;
    EV_OTT =  EV_OTT  ET EVVA1                                         ;
   FINSI                                                               ;
FINSI                                                                ;

DESS EV_OTT LEGE MIMA TAC1                                           ;

MESS '-----------------------------------> sortie  de  CONTRAPH ' ;

FINPROC ;
**** @COUTOR1
*****************************************************************
*  PROCEDURE @COUTOR1 :
*****************************************************************

DEBPROC @COUTOR1 IEL*MAILLAGE
                CHT*CHPOINT CHN*CHPOINT CHB*CHPOINT ;
PI = 3.14159 ;
P2 = IEL POIN INITIAL ;
P3 = IEL POIN FINAL ;
DIMGEO1 = VALEUR DIME ;
SI (DIMGEO1 > 2);
 NXI2 = EXTR CHN NX P2 ;
 NYI2 = EXTR CHN NY P2 ;
 NZI2 = EXTR CHN NZ P2 ;
 VN2 = NXI2 NYI2 NZI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 TZI2 = EXTR CHT TZ P2 ;
 VT2 = TXI2 TYI2 TZI2 ;
 BXI2 = EXTR CHB BX P2 ;
 BYI2 = EXTR CHB BY P2 ;
 BZI2 = EXTR CHB BZ P2 ;
 VB2 = BXI2 BYI2 BZI2 ;
 NXI3 = EXTR CHN NX P3 ;
 NYI3 = EXTR CHN NY P3 ;
 NZI3 = EXTR CHN NZ P3 ;
 VN3 = NXI3 NYI3 NZI3 ;
 TXI3 = EXTR CHT TX P3 ;
 TYI3 = EXTR CHT TY P3 ;
 TZI3 = EXTR CHT TZ P3 ;
 VT3 = TXI3 TYI3 TZI3 ;
 BXI3 = EXTR CHB BX P3 ;
 BYI3 = EXTR CHB BY P3 ;
 BZI3 = EXTR CHB BZ P3 ;
 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 P2 P3) ;
 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 P2 ;
 NYI2 = EXTR CHN NY P2 ;
 VN2 = NXI2 NYI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 VT2 = TXI2 TYI2 ;
 BXI2 = EXTR CHB BX P2 ;
 BYI2 = EXTR CHB BY P2 ;
 VB2 = BXI2 BYI2 ;
 NXI3 = EXTR CHN NX P3 ;
 NYI3 = EXTR CHN NY P3 ;
 VN3 = NXI3 NYI3 ;
 TXI3 = EXTR CHT TX P3 ;
 TYI3 = EXTR CHT TY P3 ;
 VT3 = TXI3 TYI3 ;
 BXI3 = EXTR CHB BX P3 ;
 BYI3 = EXTR CHB BY P3 ;
 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 P2 P3) ;
 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;
FINPROC DS2 R T ALPHA BETA ;
**** @COUTOR2
*****************************************************************
*  PROCEDURE @COUTOR2 : CREATION DE 2 CHAMPS PAR ELEMENTS R ET T
*****************************************************************
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;
**** @CRCACY
DEBPROC @CRCACY  XG*CHPOINT YG*CHPOINT ZG*CHPOINT ;
*
***************************************************************
* NICOLAS CURT 30032000Procedure de changement de repere.
* cartesiennes => cylindriques
*
***************************************************************
*
PHI = ATG YG XG ;

RHO   = (XG*XG + (YG*YG))**0.5 ;
*
FINPROC   RHO PHI ZG ;


**** @CRGMC
DEBPROC @CRGMC XG*CHPOINT YG*CHPOINT ZG*CHPOINT TAB1*TABLE ;
*
*******************************************************************
* Procedure de changement de repere. On passe du repere cartesien *
* global de la machine defini par son origine au centre du tore,  *
* l'axe du tore dirige suivant Z et l'axe X situe dans le plan    *
* median entre deux bobines au repere cartesien du maillage.      *
* Trois cas sont etudies : 3D, 2D en coupe Phi constant et 2D en  *
* coupe Theta constant. Alain MOAL (Decembre 1995-Janvier 1996)   *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
SI ((VALEUR DIME) EGA 2) ;
   IPLAN = TAB1.<PLAN ;
   SI (EGA IPLAN 'PHICONS') ;
      CT0 = TAB1.<CENTRE_TORE        ;
      CT1 = TAB1.<POINT_SUR_AXE_TORE ;
      P1  = TAB1.<POINT_SUR_OBJET    ;
   FINSI ;
   SI (EGA IPLAN 'THECONS') ;
      THETA0 = TAB1.<THETA0 ;
      CP  = TAB1.CENTRE_PLASMA ;
      RP  = TAB1.<RP ;
      HP  = TAB1.<HP ;
   FINSI ;
SINON ;
   CT0 = TAB1.<CENTRE_TORE        ;
   CT1 = TAB1.<POINT_SUR_AXE_TORE ;
   P1  = TAB1.<POINT_SUR_OBJET    ;
FINSI ;
ANGPHI0 = TAB1.<ANG_PHI0 ;
*------------------------------------
*
DIM0 = VALEUR DIME ;
SI (DIM0 EGA 2) ;
   OPTI DIME 3;
FINSI ;
*
SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
*  ---- en 3D ou en 2D pour la section Phi constant
   X0 Y0 Z0 = COOR CT0 ;
   X1 Y1 Z1 = COOR CT1 ;
   XP1 YP1 ZP1 = COOR P1  ;
*
*  ---- Calcul des coordonnees du point P0, projection du point P1 de
*  ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
   A = X1 - X0 ;
   B = Y1 - Y0 ;
   C = Z1 - Z0 ;
*
   SI (A EGA 0.) ;
      SI (B EGA 0.) ;
         XP0 = XP1 ;
         YP0 = YP1 ;
         ZP0 = Z0  ;
      FINSI ;
      SI (C EGA 0.) ;
         XP0 = XP1 ;
         YP0 = Y0  ;
         ZP0 = ZP1 ;
      FINSI ;
      SI ((B NEG 0.) ET (C NEG 0.)) ;
         XP0 = XP1 ;
         YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0))
               /(B*B + (C*C)) ;
         ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
      FINSI ;
   SINON ;
      AUX1 = A / (A*A + (B*B) + (C*C)) ;
      AUX2 = (B*B + (C*C)) / A ;
      XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) +
            (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
      YP0 = B * (XP0 - XP1) / A + YP1 ;
      ZP0 = C * (XP0 - XP1) / A + ZP1 ;
   FINSI ;
*
   P0 = XP0 YP0 ZP0 ;
*
*  ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
*  ---- du repere global
   LIG0 = CT0 D 1 P0 ;
   LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
*
*  ---- Calcul des 3 vecteurs unitaires du repere global
   P0X  = LIG1 POIN FINAL ;
   DIR1 = P0X MOIN CT0 ;
   VEC1 = DIR1 / (NORM DIR1) ;
   DIR3 = CT1 MOIN CT0 ;
   VEC3 = DIR3 / (NORM DIR3) ;
   VEC2 = VEC3 PVEC VEC1 ;
*
*  ---- Changement de repere
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XM1 = (A1 * XG) + (A2 * YG) + (A3 * ZG) ;
   YM1 = (B1 * XG) + (B2 * YG) + (B3 * ZG) ;
   ZM1 = (C1 * XG) + (C2 * YG) + (C3 * ZG) ;
*
   XM = XM1 + X0 ;
   YM = YM1 + Y0 ;
   ZM = ZM1 + Z0 ;
*
SINON ;
*
*  ---- en 2D pour une section a Theta constant
   XCP YCP ZCP = COOR CP ;
   NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
   ANG1 = ATG XCP YCP ;
*
*  ---- Rotation de (90 + ANGPHI0) par rapport a l'axe Z
   X1 = -1. * XG * (SIN ANGPHI0) + (YG * (COS ANGPHI0)) ;
   Y1 = -1. * XG * (COS ANGPHI0) - (YG * (SIN ANGPHI0)) ;
   Z1 = ZG ;
*
*  ---- Changement d'origine vers le centre du plasma
   X2 = X1 ;
   Y2 = Y1 + RP + (NORM_CP * (COS THETA0)) ;
   Z2 = Z1 - HP - (NORM_CP * (SIN THETA0)) ;
*
*  ---- Rotation de -THETA0 par rapport a l'axe X
   X3 = X2 ;
   Y3 = Y2 * (COS THETA0) - (Z2 * (SIN THETA0)) ;
   Z3 = Y2 * (SIN THETA0) + (Z2 * (COS THETA0)) ;
*
*  ---- Rotation de ANG1 par rapport a l'axe Z
   XM = X3 * (COS ANG1) + (Y3 * (SIN ANG1)) ;
   YM = -1. * X3 * (SIN ANG1) + (Y3 * (COS ANG1)) ;
   ZM = Z3 ;
*
FINSI ;
*
SI (DIM0 EGA 2) ;
   OPTI DIME 2;
FINSI ;
*
FINPROC XM YM ZM ;

**** @CRGTC
DEBPROC @CRGTC XG*CHPOINT YG*CHPOINT ZG*CHPOINT R*FLOTTANT
               H*FLOTTANT ;
*
***************************************************************
* Procedure de changement de repere. On passe des coordonnees *
* cartesiennes dans le repere global de la machine defini par *
* son origine au centre du tore, l'axe du tore dirige suivant *
* Z et l'axe X situe dans le plan median entre deux bobines   *
* aux coordonnees pseudo-toroidales dans un repere defini par *
* son grand rayon R et la hauteur H de son centre par rapport *
* au plan equatorial.             Alain MOAL (decembre 1995)  *
***************************************************************
*mess  ' ---> calling @CRGTC';
*
PHI = ATG YG XG ;
*
*
*---- Rotation de Phi par rapport a l'axe Z
*
X1 =       (COS PHI) * XG + ((SIN PHI) * YG) ;
Y1 = -1. * (SIN PHI) * XG + ((COS PHI) * YG) ;
Z1 = ZG ;
*
*---- Changement d'origine vers le centre du nouveau repere
X2 = X1 - R ;
Y2 = Y1     ;
Z2 = Z1 - H ;
*
*---- Calcul de Theta et Rho
*
THETA = ATG Z2 X2 ;
RHO   = (X2*X2 + (Z2*Z2))**0.5 ;
*mess  ' ---> exiting @CRGTC';
FINPROC RHO THETA PHI ;
**** @CRIT
DEBPROC @CRIT TAB1*TABLE;

MESS '---------------------------------> calling @CRIT';
MESS ' Calcul du critere d interception par le code';
*
* ========= PARAMETRES D'ENTREE
MAIL2 = TAB1.<S_OMBRANT;
ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
PASB0 = TAB1.<PAS_AVEC_TEST ;


* CALCUL DES PARAMETRES GEOMETRIQUES ENTRANT DANS *
* LE CALCUL DE DELIM                              *

* ---- CAS 3D
SI ((VALEUR DIME) EGA 3) ;
   C2MAX = 0. ;
   LMOT = MAIL2 ELEM 'TYPE' ;
   typ = table ;
   ntyp = dime LMOT ;
   bootri = faux ;
   booqua = faux ;
   repeter bouty ntyp ;
     i = &bouty ;
     typ.i = extr LMOT i ;
     si (ega typ.i tri3);bootri = vrai; finsi ;
     si (ega typ.i qua4);booqua = vrai; finsi ;
   fin bouty ;



*  ---- BOUCLE LES MAILLES TRIANGULAIRES *
   si bootri ;
   nbtri = nbel (MAIL2 elem tri3) ;
   repeter boutri nbtri ;
      i = &boutri ;
      eli = MAIL2 elem tri3 i ;
      eli = chan eli poi1 ;
*     ---- CALCUL DES DISTANCES A UN DES SOMMETS DE LA MAILLE *
      nbmai = nbno eli ;
      pt1 = elem eli point 1 ;
      pt2 = elem eli point 2 ;
      pt3 = elem eli point 3 ;
      d1_2 =  NORM (MOIN PT1 PT2) ;
      d1_3 =  NORM (MOIN PT1 PT3) ;
      d3_2 =  NORM (MOIN PT3 PT2) ;
      lid = prog d1_2 d1_3 d3_2 ;
      C2 = MAXI lid ;
      C1 = MINI lid ;

*     --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
      SI (C2 > C2MAX) ;
          C2MAX = C2 ;
          C1CO  = C1 ;
      FINSI ;
   fin boutri ;
   finsi ;



*  ---- BOUCLE LES MAILLES QUADRANGULAIRES *
   si booqua ;
   nbqua = nbel (MAIL2 elem qua4) ;

   repeter bouqua nbqua ;
      i = &bouqua ;
      eli = MAIL2 elem qua4 i ;
      eli = chan eli poi1 ;
*     ---- CALCUL DES DISTANCES ENTRE LES SOMMETS DE LA MAILLE *
      nbmai = nbel eli ;
      pt1 = elem eli point 1 ;
      pt2 = elem eli point 2 ;
      pt3 = elem eli point 3 ;
      pt4 = elem eli point 4 ;
      d1_2 = NORM (MOIN PT1 PT2) ;
      d2_3 = NORM (MOIN PT3 PT2) ;
      d3_4 = NORM (MOIN PT3 PT4) ;
      d4_1 = NORM (MOIN PT1 PT4) ;

*     ---- CAS DES RECTANGLES *
      SI ((d1_2 ega d3_4) et (d2_3 ega d4_1)) ;
          lid = prog d1_2 d2_3 ;
          c2 = maxi lid ;
          c1 = mini lid ;


*     ---- CAS D'UNE MAILLE NON STRUCTUREE *
      SINON ;
          lid = ORDONNER (prog d1_2 d2_3 d3_4 d4_1) ;

          C2 = EXTR LID 4 ;
          C1 = EXTR LID 3 ;

      FINSI ;

*     --- ON CONSIDERE LA MAILLE LA PLUS GRANDE
      SI (C2 > C2MAX) ;
          C2MAX = C2 ;
          C1CO  = C1 ;
      FINSI ;

   fin bouqua ;
   finsi ;


*  --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
delim = (((C2MAX**2)+(PASB0**2)+((C1CO*(SIN ALPHA))**2))**0.5) / 2. ;



* ---- CAS 2D (On considere le pas non projete => majore delim
SINON ;
   NSEG2 = NBEL (MAIL2 elem SEG2) ;
   CMAX = 0. ;
   REPETER BOUSEG2 NSEG2 ;
      I = &BOUSEG2 ;
      ELI = MAIL2 ELEM SEG2 I ;
      eli = chan eli poi1 ;
*     ---- CALCUL DE LA DISTANCE ENTRE LES EXTREMITES DE LA MAILLE *
      pt1 = elem eli point 1 ;
      pt2 = elem eli point 2 ;
      D1_2 =  NORM (MOIN PT1 PT2) ;
*     ---- On stocke la distance la plus grande
      SI (D1_2 > CMAX) ;
          CMAX = D1_2 ;
      FINSI ;
   FIN BOUSEG2 ;


*  --- CALCUL DU CRITERE SELON LA FORMULE TROUVEE
   DELIM = (((PASB0**2)+((CMAX*(SIN ALPHA))**2))**0.5) / 2. ;
FINSI ;

MESS '---------------------------------> exiting @CRIT';
FINPROC delim ;
**** @CRLMC
DEBPROC  @CRLMC  XL*CHPOINT YL*CHPOINT ZL*CHPOINT TAB1*TABLE ;
*
*******************************************************************
*    Version amelioree de l'ancien @CRLMC rebaptise @ACRLM        *
* Procedure de changement de repere. On passe du repere cartesien *
* local de l'objet modelise au repere cartesien du maillage. Le   *
* point de tangence au plasma est l'origine du repere local et    *
* l'axe Y est dirige vers le centre du plasma. En 3D, L'axe X du  *
* repere local est dans la direction toroidale.                   *
* en 2D cas PHICONS   l'axe Z du repere local est l'axe toroidal  *
* en 2D cas THECONS l'axe x du repere local est l'axe toroidal    *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)         *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   XPTG YPTG = COOR PTG ;
*
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = ZL ;
      ZL = ZL * 0.;
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
*     ---- rotation
      XL1 = XL * (COS ANG1)  + (YL * (-1.) * (SIN ANG1));
      YL1 = XL * (SIN ANG1)  + (YL * (COS ANG1));
   FINSI;
*  ---- changement d'origine du repere
   XM = XL1 + XPTG ;
   YM = YL1 + YPTG ;
   ZM = YL1 * 0. ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   X0 Y0 Z0 = COOR PTG ;
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XM1 = (A1 * XL) + (A2 * YL) + (A3 * ZL) ;
   YM1 = (B1 * XL) + (B2 * YL) + (B3 * ZL) ;
   ZM1 = (C1 * XL) + (C2 * YL) + (C3 * ZL) ;
*
   XM = XM1 + X0 ;
   YM = YM1 + Y0 ;
   ZM = ZM1 + Z0 ;
*
FINSI ;
FINPROC XM YM ZM ;
**** @CRLTC
DEBPROC @CRLTC TAB1*TABLE XM*CHPOINT YM*CHPOINT ZM*CHPOINT
               R*FLOTTANT ;
*
***************************************************************
* Procedure de changement de repere, on passe des             *
* coordonnees cartesiennes dans le repere de local de l'objet *
* XM YM ZM repere defini par  TAB1.<RHO0, TAB1.<THETA0 et     *
* TAB1.<RP aux coordonnees pseudo-toroidales defini par un    *
* grand rayon donne R .            Alain MOAL (mai 1995)      *
***************************************************************
*
*--------------- VARIABLES D'ENTREE :
RHO0   =  TAB1.<RHO0   ;
THETA0 =  TAB1.<THETA0 ;
RP     =  TAB1.<RP     ;
*------------------------------------
*
CT0 = COS THETA0 ;
ST0 = SIN THETA0 ;
MST0 = ST0 * -1. ;
*
*---- 1) rotation d'angle THETA0 autour de l'axe X
X1 = XM                                       ;
Y1 =      (YM * CT0)            + (ZM * ST0)  ;
Z1 =      (YM * MST0)           + (ZM * CT0)  ;
*
*---- 2) changement d'origine vers le centre du tore,
*----    rotation de 180 degres autour de l'axe Z2 pour
*----    retrouver le repere global puis calcul de PHI
X2 = X1                       ;
Y2 = Y1 - (RHO0 * CT0 + RP)   ;
Z2 = Z1 + (RHO0 * ST0)        ;
*
X2 = X2 * -1.  ;
Y2 = Y2 * -1.  ;
PHI = ATG (X2 * -1.) Y2 ;
*
*---- 3) rotation d'angle PHI autour de l'axe Z2
CPHI = COS PHI     ;
SPHI = SIN PHI     ;
MSPHI = SPHI * -1. ;
X3 = (X2 * CPHI)      + (Y2 * SPHI)       ;
Y3 = (X2 * MSPHI)     + (Y2 * CPHI)       ;
Z3 =                                  Z2  ;
*
*---- 4) changement d'origine vers le centre du nouveau repere
X4 = X3     ;
Y4 = Y3 - R ;
Z4 = Z3     ;
*
*---- calcul de RHO et THETA
RHO = ((Y4 * Y4) + (Z4 * Z4))**0.5 ;
THETA = ATG Z4 Y4 ;
*
MESS '>>>> @CRLTC : max and min of the angle PHI' ;
MESS (MAXI PHI) (MINI PHI) ;
*
FINPROC RHO THETA PHI ;
**** @CRMGC
DEBPROC @CRMGC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
*
*******************************************************************
* Procedure de changement de repere. On passe du repere cartesien *
* quelconque du maillage au repere cartesien global de la machine *
* defini par son origine au centre du tore, l'axe du tore dirige  *
* suivant Z et l'axe X situe dans le plan median entre deux       *
* bobines. Trois cas sont etudies : 3D, 2D en coupe Phi constant  *
* et 2D en coupe Theta constant.  Alain MOAL (Decembre 1995)      *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
SI ((VALEUR DIME) EGA 2) ;
   IPLAN = TAB1.<PLAN ;
   SI (EGA IPLAN 'PHICONS') ;
      CT0 = TAB1.<CENTRE_TORE        ;
      CT1 = TAB1.<POINT_SUR_AXE_TORE ;
      P1  = TAB1.<POINT_SUR_OBJET    ;
   FINSI ;
   SI (EGA IPLAN 'THECONS') ;
      THETA0 = TAB1.<THETA0 ;
      CP  = TAB1.CENTRE_PLASMA ;
      RP  = TAB1.<RP ;
      HP  = TAB1.<HP ;
   FINSI ;
SINON ;
   CT0 = TAB1.<CENTRE_TORE        ;
   CT1 = TAB1.<POINT_SUR_AXE_TORE ;
   P1  = TAB1.<POINT_SUR_OBJET    ;
FINSI ;
ANGPHI0 = TAB1.<ANG_PHI0 ;
*------------------------------------
*
DIM0 = VALEUR DIME ;
SI (DIM0 EGA 2) ;
   OPTI DIME 3;
FINSI ;
*
SI (((DIM0 EGA 2) ET (EGA IPLAN 'PHICONS')) OU (DIM0 EGA 3)) ;
*  ---- en 3D ou en 2D pour la section Phi constant
   X0 Y0 Z0 = COOR CT0 ;
   X1 Y1 Z1 = COOR CT1 ;
   XP1 YP1 ZP1 = COOR P1 ;
*
*  ---- Calcul des coordonnees du point P0, projection du point P1 de
*  ---- l'objet dans le plan orthogonal a l'axe du tore en CT0.
   A = X1 - X0 ;
   B = Y1 - Y0 ;
   C = Z1 - Z0 ;
*
   SI (A EGA 0.) ;
      SI (B EGA 0.);
         XP0 = XP1 ;
         YP0 = YP1 ;
         ZP0 = Z0  ;
      FINSI ;
      SI (C EGA 0.) ;
         XP0 = XP1 ;
         YP0 = Y0  ;
         ZP0 = ZP1 ;
      FINSI ;
      SI ((B NEG 0.) ET (C NEG 0.)) ;
         XP0 = XP1 ;
         YP0 = (-1.*B*C*ZP1 + (C*C*YP1) + (B*B*Y0) + (B*C*Z0))
               /(B*B + (C*C)) ;
         ZP0 = (B*ZP1 - (C*YP1) + (C*(Y0+Z0)))/(B+C);
      FINSI ;
   SINON ;
      AUX1 = A / (A*A + (B*B) + (C*C)) ;
      AUX2 = (B*B + (C*C)) / A ;
      XP0 = AUX1 * (A*X0 + (B*Y0) + (C*Z0) +
            (AUX2*XP1) - (B*YP1) - (C*ZP1)) ;
      YP0 = B * (XP0 - XP1) / A + YP1 ;
      ZP0 = C * (XP0 - XP1) / A + ZP1 ;
   FINSI ;
*
   P0 = XP0 YP0 ZP0 ;
*
*  ---- Rotation de la ligne (CT0,P0) pour l'aligner sur l'axe X
*  ---- du repere global
   LIG0 = CT0 D 1 P0 ;
   LIG1 = LIG0 TOUR (-1.*ANGPHI0) CT0 CT1 ;
*
*  ---- Calcul des 3 vecteurs unitaires du repere global
   P0X  = LIG1 POIN FINAL ;
   DIR1 = P0X MOIN CT0 ;
   VEC1 = DIR1 / (NORM DIR1) ;
   DIR3 = CT1 MOIN CT0 ;
   VEC3 = DIR3 / (NORM DIR3) ;
   VEC2 = VEC3 PVEC VEC1 ;
*
*  ---- Changement de repere
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XG1 = XM - X0 ;
   YG1 = YM - Y0 ;
   ZG1 = ZM - Z0 ;
*
   XG = (A1 * XG1) + (B1 * YG1) + (C1 * ZG1) ;
   YG = (A2 * XG1) + (B2 * YG1) + (C2 * ZG1) ;
   ZG = (A3 * XG1) + (B3 * YG1) + (C3 * ZG1) ;
*
SINON ;
*  ---- en 2D pour une section a Theta constant
*
   XCP YCP ZCP = COOR CP ;
   NORM_CP = (XCP*XCP + (YCP*YCP) + (ZCP*ZCP))**0.5 ;
   ANG1 = ATG XCP YCP ;
*
*  ---- Rotation de - ANG1 par rapport a l'axe Z
   X1 = XM * (COS ANG1) - (YM * (SIN ANG1)) ;
   Y1 = XM * (SIN ANG1) + (YM * (COS ANG1)) ;
   Z1 = ZM ;
*
*  ---- Rotation de THETA0 par rapport a l'axe X
   X2 = X1 ;
   Y2 = Y1 * (COS THETA0) + (Z1 * (SIN THETA0)) ;
   Z2 = -1. * Y1 * (SIN THETA0) + (Z1 * (COS THETA0)) ;
*
*  ---- Changement d'origine vers le centre du tore
   X3 = X2 ;
   Y3 = Y2 - RP - (NORM_CP * (COS THETA0)) ;
   Z3 = Z2 + HP + (NORM_CP * (SIN THETA0)) ;
*
*  ---- Rotation de -(90 + ANGPHI0) par rapport a l'axe Z
   XG = -1. * X3 * (SIN ANGPHI0) - (Y3 * (COS ANGPHI0)) ;
   YG = X3 * (COS ANGPHI0) - (Y3 * (SIN ANGPHI0)) ;
   ZG = Z3 ;
*
FINSI;
*
SI (DIM0 EGA 2) ;
   OPTI DIME 2;
FINSI ;
*
FINPROC XG YG ZG ;



**** @CRMLC
DEBPROC @CRMLC XM*CHPOINT YM*CHPOINT ZM*CHPOINT TAB1*TABLE ;
*
*******************************************************************
*    Version amelioree de l'ancien @CRMLC rebaptise @ACRML        *
* Procedure de changement de repere. On passe du repere cartesien *
* du maillage au repere cartesien local de l'objet modelise. Le   *
* point de tangence au plasma est l'origine de ce repere et l'axe *
* l'axe Y final est dirige vers le centre du plasma.              *
* en 3D l'axe x du repere local est donne par la direction        *
* toroidale                                                       *
* en 2D cas PHICONS   l'axe Z initial est l'axe toroidal          *
* en 2D cas THECONS l'axe x initial est l'axe toroidal            *
*         Jacques SCHLOSSER et Alain MOAL (Decembre 1995)         *
*******************************************************************
*
*--------------- VARIABLES D'ENTREE :
CP  = TAB1.CENTRE_PLASMA ;
PTG = TAB1.PT_TGPLASMA   ;
SI ((VALEUR DIME) EGA 2) ;
   SI (EXISTE TAB1 <PLAN) ;
      IPLAN = TAB1.<PLAN ;
   SINON ;
      ERRE '>>>> TAB1.<PLAN n existe pas' ;
   FINSI ;
SINON ;
   SI (EXISTE TAB1 <DIR_TOROIDAL) ;
      DIR1 = TAB1.<DIR_TOROIDAL ;
   SINON ;
      ERRE '>>>> TAB1.<DIR_TOROIDAL n existe pas' ;
   FINSI ;
FINSI ;
*------------------------------------
*
SI ((VALEUR DIME) EGA 2) ;
   VECT0 = CP MOINS PTG ;
   VX VY = COOR VECT0   ;
*
*  ---- calcul de l'angle de rotation dans le plan XY
   SI ((VX EGA 0.) ET (VY EGA 0.)) ;
      ANG1 = 0. ;
   SINON ;
      ANG1 = -1.* (ATG VX VY) ;
   FINSI ;
*
   XPTG YPTG = COOR PTG ;
*
*  ---- changement d'origine du repere
   XM1 = XM - XPTG ;
   YM1 = YM - YPTG ;
*  ---- rotation pour aligner l'axe Y avec VECT0
   SI (EGA IPLAN 'PHICONS');
*     ---- Coupe 2D a Phi constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
*
      ZL = XL ;
      XL = XL * 0.;
   FINSI;
   SI (EGA IPLAN 'THECONS');
*     ---- Coupe 2D a Theta constant
      XL = XM1 * (COS ANG1)          + (YM1 * (SIN ANG1));
      YL = XM1 * (-1.) * (SIN ANG1)  + (YM1 * (COS ANG1));
      ZL = XM * 0. ;
   FINSI ;
*
SINON ;
*
   VEC1 =  DIR1 / (NORM DIR1) ;
   DIR2 =  CP MOINS PTG ;
   VEC2 =  DIR2 / (NORM DIR2) ;
   VEC3 =  VEC1 PVEC VEC2 ;
*
   X0 Y0 Z0 = COOR PTG ;
   A1 B1 C1 = COOR VEC1 ;
   A2 B2 C2 = COOR VEC2 ;
   A3 B3 C3 = COOR VEC3 ;
*
   XM1 = XM - X0 ;
   YM1 = YM - Y0 ;
   ZM1 = ZM - Z0 ;
*
   XL = (A1 * XM1) + (B1 * YM1) + (C1 * ZM1) ;
   YL = (A2 * XM1) + (B2 * YM1) + (C2 * ZM1) ;
   ZL = (A3 * XM1) + (B3 * YM1) + (C3 * ZM1) ;
*
FINSI ;
FINPROC XL YL ZL ;


**** @CRTGC
DEBPROC @CRTGC RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT R*FLOTTANT
               H*FLOTTANT ;
*
*****************************************************************
* Procedure de changement de repere. On passe des coordonnees   *
* pseudo-toroidales dans un repere defini par son grand rayon R *
* et la hauteur H de son centre par rapport au plan equatorial  *
* aux coordonnees cartesiennes dans le repere global de la      *
* machine defini par son origine au centre du tore, l'axe du    *
* tore dirige suivant Z et l'axe X situe dans le plan median    *
* entre deux bobines.               Alain MOAL (decembre 1995)  *
*****************************************************************
*
X2 = RHO * (COS THETA) ;
Y2 = RHO * 0. ;
Z2 = RHO * (SIN THETA) ;
*
*---- Changement d'origine vers le centre du tore
X1 = X2 + R ;
Y1 = Y2 ;
Z1 = Z2 + H ;
*
*---- Rotation de - phi par rapport a l'axe Z
XG = (COS PHI) * X1 - ((SIN PHI) * Y1) ;
YG = (SIN PHI) * X1 + ((COS PHI) * Y1) ;
ZG = Z1 ;
*
FINPROC XG YG ZG ;
**** @CRTLC
DEBPROC  @CRTLC  R*FLOTTANT RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT
                 TAB1*TABLE ;
*
***************************************************************
* Procedure de changement de repere, on passe des coordonnees *
* pseudo-toroidales centrees sur un grand rayon R aux         *
* coordonnees cartesiennes dans le repere de la structure     *
* modelisee.                  Alain MOAL (mai 1995)           *
***************************************************************
*
*--------------- VARIABLES D'ENTREE :
RHO0   =  TAB1.<RHO0   ;
THETA0 =  TAB1.<THETA0 ;
RP     =  TAB1.<RP     ;
*------------------------------------
*
CT0 = COS THETA0 ;
ST0 = SIN THETA0 ;
MST0= ST0 * -1.  ;
CPHI = COS PHI   ;
SPHI = SIN PHI   ;
MSPHI = SPHI * -1. ;
*
X4 = RHO * 0.          ;
Y4 = RHO * (COS THETA) ;
Z4 = RHO * (SIN THETA) ;
*
*---- 1) changement d'origine vers le centre du tore
X3 = X4       ;
Y3 = Y4 + R   ;
Z3 = Z4       ;
*
*---- 2) rotation d'angle - PHI autour de l'axe Z3
*        puis rotation de - 180 degres autour de l'axe Z2
X2 = (X3 * CPHI)    + (Y3 * MSPHI)         ;
Y2 = (X3 * SPHI)    + (Y3 * CPHI)          ;
Z2 =                                  Z3   ;
*
X2 = X2 * -1. ;
Y2 = Y2 * -1. ;
*
*---- 3) changement d'origine vers le centre d'objet
X1 = X2                       ;
Y1 = Y2 + RP + (RHO0 * CT0)   ;
Z1 = Z2 - (RHO0 * ST0)        ;
*
*---- 4) rotation d'angle - THETA0 autour de l'axe X1
XP = X1                             ;
YP =      (Y1 * CT0)  + (Z1 * MST0) ;
ZP =      (Y1 * ST0)  + (Z1 * CT0)  ;
*
FINPROC XP YP ZP ;
**** @CRTTC
DEBPROC @CRTTC R1*FLOTTANT RHO1*CHPOINT THETA1*CHPOINT
               PHI1*CHPOINT R2*FLOTTANT ;
*
***************************************************************
* Procedure de changement de repere. On passe d'un repere     *
* pseudo-toroidal defini par son grand rayon R1 a un autre    *
* repere pseudo-toroidal defini par son grand rayon R2. Ces   *
* deux reperes ont la meme orientation toroidale: Phi1 = Phi2 *
*                 Alain MOAL (juin 1995)                      *
***************************************************************
*
RHO2 = RHO1**2 + ((R1 - R2)**2) ;
RHO2 = RHO2 + (RHO1*(R1 - R2)*(COS THETA1)*2.) ;
RHO2 = RHO2**0.5 ;
*
AUX1 = RHO1 * (SIN THETA1) ;
AUX2 = RHO1 * (COS THETA1) - R2 + R1 ;
THETA2 = ATG AUX1 AUX2 ;
*
PHI2 = PHI1 ;
*
FINPROC RHO2 THETA2 PHI2 ;
**** @CSHIFT
DEBPROC  @CSHIFT  RHOM*CHPOINT THETAM*CHPOINT PHIM*CHPOINT
                  IMETHOD*ENTIER TAB1*TABLE ;
*
***************************************************************
* Procedure de calcul des grand et petit rayons du "cercle de *
* Shafranov" en chaque point M defini dans le repere centre   *
* sur le plasma. On calcule de plus l'angle theta dans le     *
* repere centre sur le cercle calcule.                        *
* Deux methodes sont utilisees pour calculer le grand rayon.  *
*                 Alain MOAL (aout-sept 1995)                 *
***************************************************************
*
*--------------- VARIABLES D'ENTREE :
RP    =  TAB1.<RP    ;
RHO0  =  TAB1.<RHO0  ;
LAMB  =  TAB1.<LAMB  ;
*------------------------------------
*
SI ((NON (IMETHOD EGA 1)) ET (NON (IMETHOD EGA 2))) ;
   ERRE '>>>> @CSHIFT : YOU MUST CHOOSE THE METHOD 1 OR 2' ;
FINSI ;
*
*---- variables auxiliaires
A = ((RHOM/RHO0)**-2) + 1. ;
A = A * (LAMB + 0.5) ;
A = A + (LOG (RHOM/RHO0)) - 1. ;
B = LOG (RHOM/RHO0) ;
B = B - ((((RHOM/RHO0)**-2) - 1.) * (LAMB + 0.5)) ;
STM = SIN THETAM ;
CTM = COS THETAM ;
AUX1 = 1. + LAMB ;
AUX2 = RHOM * CTM + RP ;
AUX3 = RHOM * STM      ;
*
*---- TEST : calcul du decentrement par la methode de Shafranov
DELT0 = B * (RHOM**2) / (2.*RP) ;
MESS '*** TEST : DELT0 *** '; LIST DELT0 ;
*---- FIN TEST
*
SI (IMETHOD EGA 1) ;
*  ---- calcul du grand rayon
*
* RM 08/04/97 J'enleve STM qui figure a la fois au numerateur et au
denominateur
* dans l'expression definie par les trois lignes suivantes
* Il provoque une division par 0 quand des points du maillage sont dans le plan
* equatorial
*
   GRANDR = RHOM * RP * CTM * (A - B) ;
   GRANDR = GRANDR + (2.*(RP**2) - (B*(RHOM**2))) ;
   GRANDR = GRANDR / (2.*RP + (RHOM*CTM*(A - B))) ;
FINSI ;
*
SI (IMETHOD EGA 2) ;
   DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * (
           ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) -
           ((RHO0**2) * AUX1)))   ;
*
*  ---- deux cercles possibles
   GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
   GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
*
*  ---- choix du bon cercle
   SI ((COS THETAM) >EG 0.) ;
      GRANDR = GRANDR2     ;
   SINON                   ;
      GRANDR = GRANDR1     ;
   FINSI                   ;
FINSI ;
*
*---- calcul du petit rayon
PETITR = ((RHOM*CTM+RP-GRANDR)**2 + ((RHOM*STM)**2))**0.5 ;
*
*--- calcul de theta dans le repere centre sur le cercle calcule
THETAR = ATG (RHOM * STM) (RHOM * CTM + RP - GRANDR) ;
*
*---- test (methode 1)
*AM*TERME1 = PETITR * LAMB * (COS THETAR) / GRANDR ;
*AM*TERME2 = (STM**2 * B + ((CTM**2) * A))/(2.*RP) ;
*AM*TERME2 = TERME2 + (CTM / RHOM) ;
*AM*TERME2 = TERME2 * (RP - GRANDR);
*AM*TERME2 = TERME2 + (RHOM * CTM * A / (2.*RP)) ;
*AM*ERREUR0 = (ABS ((TERME1-TERME2)/TERME2)) ;
*AM*MESS 'TEST'; LIST TERME1; LIST TERME2; LIST ERREUR0;
*
FINPROC GRANDR PETITR THETAR;

**** @CVECT
DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT
               MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
*
**************************************************************
* Procedure de creation d'un objet de type vecteur a partir  *
* des composantes d'un champ de vecteurs.                    *
* Si le facteur d'amplification pour visualiser un champ de  *
* vecteur sur une geometrie n'est pas donne,il est adapte    *
* aux dimensions geometriques du probleme.                   *
*                Alain MOAL (juillet 1995)                   *
**************************************************************
*
XM = COOR 1 MAIL0 ;
YM = COOR 2 MAIL0 ;
SI ((VALEUR DIME) EGA 2) ;
   ZM = XM * 0. ;
SINON ;
   ZM = COOR 3 MAIL0 ;
FINSI ;
*
SI (NON (EXISTE AMPLI0)) ;
*  ---- norme du vecteur
   VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
* RM 16.01.03
mess '>> ccect'  ;
@listmm VECNORM ;
*
*  ---- calcul d'une longueur caracteristique du maillage
   LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
   LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
   LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
*
   SI ((VALEUR DIME) EGA 2) ;
      LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
   SINON ;
      LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
   FINSI ;
*
   AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
*AM*   AMPLI0 = LONGCAR / (MAXI VECNORM) ;
*AM*  AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
FINSI ;
*
SI ((VALEUR DIME) EGA 2) ;
   CHV1  = @ET (NOMC UX XV) (NOMC UY YV) ;


*CAST94*   CHV1  = (NOMC UX XV) ET (NOMC UY YV) ;
   VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
SINON ;
   CHV1  = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
*CAST94* CHV1  = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
   VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
FINSI ;
FINPROC VECT1 ;

**** ARBRE              derniere modif  16/04/91
  DEBPROC ARBRE MAILSEG*MAILLAGE   IMEN*ENTIER;
*   determination du maillage des aretes de la surface de separation
*     en seg2  sera a changer si  p2 au lieu de p1
* HDL CHPOINT  VIDE SUR DFCAN  EN ENTREE
 MAILSEG = MAILSEG COUL BLAN ;
 NPB= MAILSEG NBNO ;
 IP= 0;
 MESS ' ************************** ' ;
* TEMPS ;
 MESS ' ************************** ' ;
 MESS ' NBRE DE POINTS  DE LA SURFACE DE SEPARATION ' NPB;
 MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
 IPASS= 0;IMA= 0 ;
 REPETER  BOUC1  ;
 IPASS= IPASS + 1;IMA= IMA + 1 ;
  ALBERT= MAILSEG ELEM BLAN ;
 ITUR= 0;
 REPETER  BOUCON ;
 ITUR= ITUR + 1 ;
 P1= ALBERT POINT ITUR;
  SEGBL= ALBERT ELEM 'APPUYE'  LARGEMENT  P1 ;NBL= SEGBL NBEL ;
  SEGPT= MAILSEG  ELEM 'APPUYE'  LARGEMENT  P1 ;NBT= SEGPT NBEL ;
 SI (( NBL  <  NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
 FIN BOUCON ;
 SI (IPASS >  1);
* TRAC OEIL ((SEGBL COUL ROUG)
*          ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
 FINSI ;
 IBL= 0 ;
* on ordonne les segments connectes a P1  sens P1 PN
   REPETER BOUC0 NBL ;
   IBL= IBL + 1 ;
   SSS= SEGBL ELEM IBL ;  1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
   SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
       SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
       SSI = SSI ET SSS ;   FINSI ;
       2P= SSS POINT FINAL ;
   FIN BOUC0 ;
 SEGBL= SSI ;

*  SI NBL > 1 ON VA ELIMINER  LES DOUBLES DE  SEGBL

   IA=0 ;
   SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 )  COUL VERT ;
   2P= SEG1 POINT FINAL ;
   MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
   FINSI ;
   SI ( NBL > 1 ) ;
    REPETER BOUC2  (NBL - 1 );
   IA= IA + 1 ;
   SEG1 = ( SEGBL  ELEM  IA ) COUL VERT ;
   PP1= SEG1  POINT FINAL ;
   I3= IA + 1 ;
    REPETER BOUC3  ;
    SI ( I3  >  NBL ) QUITTER BOUC3 ; FINSI ;
    SEG2 = SEGBL ELEM I3 ;
    PP2=SEG2  POINT FINAL;
       SI ( PP1 EGA PP2 ) ;
       MAILSEG= (DIFF MAILSEG  SEG2 );
*       MESS ' ELIMINATION  DU NO  ' I3 ;
       FINSI ;
    I3= I3 + 1;
    FIN BOUC3 ;
    MAILSEG = ( DIFF MAILSEG SEG1 ) ET  SEG1;
   FIN BOUC2 ;
    FINSI ;
    N1= (MAILSEG ELEM VERT) NBEL  ;N2= MAILSEG  NBEL ;
* TRAC OEIL MAILSEG ;
     SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
  SI ( EGA IMA IMEN) ; MENAGE ;IMA = 0 ; FINSI ;
 FIN BOUC1 ;
 SAUTER 2 LIGNES ;
 MESS  ' NB D ARETES  AYANT SERVI A L INTEGRATION  ' N2 ;
 MESS ' ************************** ' ;
*TEMPS ;
 MAILSEG= MAILSEG ELEM VERT ;
* HDL= IN_MINI  (MAILSEG ELEM VERT )  TABHS  ORIG B_ANTI ;
 FINPROC MAILSEG;
**** FL_HS                  derniere modif  16/04/91
 DEBPROC  FL_HS  DFCANT*MAILLAGE TABHS*TABLE TYEL*MOT OBJV*MMODEL;
*  chamelem  des projections de hs sur les normales  des elements
*     au cdg
 HPX=REDU (TABHS.1) DFCANT  ;
 HPY=REDU (TABHS.2) DFCANT  ;
 HPZ=REDU (TABHS.3) DFCANT  ;
  IP= 0;
 OB1= DFCANT  AFFECT  (MODELE STANDARD ) TYEL  ;
 NBP= DFCANT NBNO ;
 FLHS= MANU CHPO DFCANT  1 'Q' ( PROG NBP * 0. );
*   calcul des moyennes sur l element
 HSXM = PRCH  HPX  OB1  'GRAVITE' ;
 HSYM = PRCH  HPY  OB1  'GRAVITE' ;
 HSZM = PRCH  HPZ  OB1  'GRAVITE' ;
 HNMP = MANU CHAM  OB1  'GRAVITE' SCAL 0. ;
 BBNEL= DFCANT NBEL ;
*
 IP= 0 ;
 IMENA= 0 ;
 REPETER BOUCEL BBNEL ;
 IMENA= IMENA + 1 ;
  IP=IP + 1 ; TOTO= DFCANT  ELEM IP ; ITOT= CHAN POI1 TOTO ;
  T1= ITOT POINT 1 ;T2= ITOT POINT 2 ; T3= ITOT POINT 3 ;
*    normale a l element
  V1= T2 MOINS T1 ; V2= T3 MOINS T1 ; NNN= V1 PVECT V2 ;
 NNNR= NNN / (NORM NNN) ;
 CVX= COOR 1 NNNR ;CVY= COOR 2 NNNR ; CVZ= COOR 3 NNNR ;
 HSXE= EXTR HSXM SCAL 1 IP 1 ;
 HSYE= EXTR HSYM SCAL 1 IP 1 ;
 HSZE= EXTR HSZM SCAL 1 IP 1 ;
 VPROJ = (HSXE * CVX ) + (HSYE * CVY ) + (HSZE * CVZ) ;
 FLHS1= FLHS + ( FLUX OBJV  VPROJ TOTO ) ;
 DETR FLHS ;FLHS = FLHS1  ;DETR TOTO ;DETR ITOT;
 SI ( EGA IMENA 50 ) ; MESS '  menage ';
  MENAGE ; IMENA= 0 ; FINSI ;
 FIN BOUCEL ;
  FINPROC  FLHS ;
**** IN_MINI                 derniere modif  16/04/91
  'DEBPROC' IN_MINI  FCAN*'MAILLAGE'  TABHS*TABLE  ORIG*POINT
    B_ANTI*MAILLAGE ;
*   integration   de v  par minimisation  fonctionnelle
*   en entree   maillage frontiere cote phi et hs sur ce maiilage
*   en sortie   V(b)= phi(b)-psi(b)  chpoint sur fcan
*    avec psi(p1) = phi(p1)
  HX=TABHS.1;HY=TABHS.2;HZ=TABHS.3;
  nbi = nbno ( fcan elem 1 ) ;
  I= 0 ;
  MESS ' SEPARATION ' (FCAN NBNO)  'POINTS'  (FCAN NBEL) 'ELEM ';
  REPE BLOCALC (NBEL FCAN);
  I= I + 1 ;
  SEGCOU = FCAN ELEM I;
  P1 = SEGCOU POIN 1;
  P2 = SEGCOU POIN 2;
  HX1 = EXTR  HX  SCAL P1 ; HX2 = EXTR  HX SCAL  P2 ;
  HY1 = EXTR  HY  SCAL P1 ; HY2 = EXTR  HY SCAL  P2 ;
  HZ1 = EXTR  HZ  SCAL P1 ; HZ2 = EXTR  HZ SCAL  P2 ;
  HMOY =(( HX1 +  HX2) / 2.) ( ( HY1 + HY2) / 2.) ((HZ1 + HZ2) / 2.);
*     si ( ega nbi 3 ) ;
*     p3= segcou point 3 ;
*     hmx= extr hx scal p3 ;
*     hmy= extr hy scal p3 ;
*     hmz= extr hz scal p3 ;
*     hmil= ( hmx hmy hmz ) * 4. ;
*     hmoy =(  hmoy / 3. )  + ( hmil / 6. )
*     finsi ;
  VL= P2 MOINS P1 ;DL= NORM VL ;VL=VL / DL ;
  DV =  (VL PSCAL HMOY ) ;DVI= DV * -1.;
  TI= 1. / DL ;IT= -1. * TI ;
  RIGEL= MANU RIGIDITE SEGCOU  (MOTS T )  (PROG TI IT TI) ;
  HH= MANU CHPO SEGCOU 1 'Q'  (PROG  DVI DV );
  SI (EGA I 1);
  RIGT = RIGEL ;
  HTH  = HH ;
  SINON ;
  RIGT1= RIGT ET RIGEL;
  HTH1= HTH ET HH ;
  DETR RIGT;RIGT= RIGT1 ; DETR HTH ;HTH= HTH1 ;
  DETR HH; DETR RIGEL ;
  FINSI ;
   FIN BLOCALC ;
  TITI = RELA 'ENSE'  T  B_ANTI  ;
  TUTU= BLOQUE   ORIG   T;
  HHHH= RESOU (RIGT ET TUTU ET TITI ) HTH ;
  HHHH= (ENLEVER HHHH LX ) NOMC 'SCAL';
  FINPROC HHHH ;
**** ARBRE_IN                    derniere modif  16/04/91
 DEBPROC ARBRE_IN DFCAN*MAILLAGE  TABHS*TABLE ORIG*POINT ;
*   CALCUL DE L ARBORESCENCE  ET INTEGRATION  DE HS.DL
*   cette methode  amene des differences suivant le chemin choisi
* il vaut mieux utiliser l autre  ( minimisation)
*  DFCAN  SURFACE DE SEPARATION
* HDL CHPOINT  VIDE SUR DFCAN  EN ENTREE
 NPB= DFCAN NBNO ;
 HDL= MANU CHPO DFCAN  1 SCAL ( PROG NPB * 0.) ;

 DFCAN= DFCAN COUL BLAN ;
 DFCAN1 = DFCAN ELEM QUA4 ;NELSURF1= DFCAN1 NBEL;
 DFCAN2 = DFCAN ELEM TRI3 ; NELSURF2= DFCAN2 NBEL;
  MAILSEG= CONT ( DFCAN1 ELEM 1 );
  I= 1 ;
 REPE BOUCSEG1 ( NELSURF1 - 1 );
  I = I + 1;
  MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
 FIN BOUCSEG1;
  I= 0 ;
 REPE BOUCSEG2  NELSURF2;
  I = I + 1;
  MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
 FIN BOUCSEG2;

 NPB= MAILSEG NBNO ;
 IP= 0;
 MESS ' ************************** ' ;
*TEMPS ;
 MESS ' ************************** ' ;
 MESS ' NBRE DE POINTS  DE LA SURFACE DE SEPARATION ' NPB;
 MESS ' NBRE D ELEMENTS DE LA SURFACE DE SEPARATION ' (MAILSEG NBEL);
 IPASS= 0;
 REPETER  BOUC1  ;
 IPASS= IPASS + 1;
  ALBERT= MAILSEG ELEM BLAN ;
 ITUR= 0;
 REPETER  BOUCON ;
 ITUR= ITUR + 1 ;
 P1= ALBERT POINT ITUR;
  SEGBL= ALBERT ELEM 'APPUYE'  LARGEMENT  P1 ;NBL= SEGBL NBEL ;
  SEGPT= MAILSEG  ELEM 'APPUYE'  LARGEMENT  P1 ;NBT= SEGPT NBEL ;
 SI (( NBL  <  NBT) OU ('EGA' IPASS 1)) ; QUITTER BOUCON ;FINSI ;
 FIN BOUCON ;
 DETR ALBERT ; DETR SEGPT ;
 SI (IPASS >  1);
* TRAC OEIL ((SEGBL COUL ROUG)
*          ET (MAILSEG ELEM BLAN) ET (MAILSEG ELEM VERT)) NOEUDS;
 FINSI ;
 IBL= 0 ;
* on ordonne les segments connectes a P1  sens P1 PN
   REPETER BOUC0 NBL ;
   IBL= IBL + 1 ;
   SSS= SEGBL ELEM IBL ;  1P= SSS POINT INITIAL ;2P= SSS POINT FINAL ;
   SI ( 1P NEG P1 ) ; SSS= (INVE SSS) ; FINSI ;
       SI (IBL EGA 1 ) ; SSI= SSS;SINON ;
       SSI1 = SSI ET SSS ;DETR SSI ; SSI = SSI1 ;
       FINSI ;
       2P= SSS POINT FINAL ;DETR SSS ;
   FIN BOUC0 ;
 SEGBL= SSI ;

*  SI NBL > 1 ON VA ELIMINER  LES DOUBLES DE  SEGBL

   IA=0 ;
   SI ( NBL EGA 1 );SEG1= (SEGBL ELEM 1 )  COUL VERT ;
   2P= SEG1 POINT FINAL ;
   VV= EXTR HDL SCAL 2P ;
        SI (( EGA VV 0.) ET (2P NEG ORIG));
        HDL=INT_BIOT HDL P1 2P ORIG TABHS ;
        FINSI ;
   MAILSEG= ( DIFF MAILSEG SEG1 ) ET SEG1 ;
   FINSI ;
   SI ( NBL > 1 ) ;
    REPETER BOUC2  (NBL - 1 );
   IA= IA + 1 ;
   SEG1 = ( SEGBL  ELEM  IA ) COUL VERT ;
   PP1= SEG1  POINT FINAL ;
   VV= EXTR HDL SCAL PP1 ;
        SI ((EGA VV 0.) ET (PP1 NEG ORIG));
        HDL=INT_BIOT HDL P1 PP1 ORIG TABHS ;
        FINSI ;
   I3= IA + 1 ;
    REPETER BOUC3  ;
    SI ( I3  >  NBL ) QUITTER BOUC3 ; FINSI ;
    SEG2 = SEGBL ELEM I3 ;
    PP2=SEG2  POINT FINAL;
       SI ( PP1 EGA PP2 ) ;
       MAILSEG1= (DIFF MAILSEG  SEG2 );DETR MAILSEG ;MAILSEG= MAILSEG1 ;
*       MESS ' ELIMINATION  DU NO  ' I3 ;
       FINSI ;
*tc mise en commentaire du finsi
*    FINSI;
    I3= I3 + 1;
    FIN BOUC3 ;
    MAILSEG1 = ( DIFF MAILSEG SEG1 ) ET  SEG1;
    DETR MAILSEG ; MAILSEG= MAILSE1 ;
   FIN BOUC2 ;
    FINSI ;
    N1= (MAILSEG ELEM VERT) NBEL  ;N2= MAILSEG  NBEL ;
* TRAC OEIL MAILSEG ;
     SI ( N1 EGA N2 ) ; QUITTER BOUC1 ; FINSI ;
 FIN BOUC1 ;
 DETR SEGBL ;
 SAUTER 2 LIGNES ;
 MESS  ' NB D ARETES  AYANT SERVI A L INTEGRATION  ' N2 ;
 MESS ' ************************** ' ;
*TEMPS ;
 MESS ' ************************** ' ;
*       sortie hdl   chpoint   de   V
 FINPROC    HDL ;
**** INT_BIOT                 derniere modif  16/04/91
 DEBPROC  INT_BIOT  HDL*CHPOINT   1P*POINT 2P*POINT  ORIG*POINT
          TABHS*TABLE  ;
* integration de ht.dl  sur le long des aretes  sur la surface de
*  separation
 HSX= TABHS.1 ;HSY=TABHS.2;HSZ= TABHS.3 ;
*  HDL EST LE STOCKAGE  DU RESULTAT
*         integrale sur le segment
 XHS1= EXTR HSX SCAL 1P;YHS1= EXTR HSY SCAL 1P; ZHS1= EXTR HSZ SCAL 1P;
 XHS2= EXTR HSX SCAL 2P;YHS2= EXTR HSY SCAL 2P; ZHS2= EXTR HSZ SCAL 2P;
       XHM= (XHS1 + XHS2 ) / 2.;
       YHM= (YHS1 + YHS2 ) / 2.;
       ZHM= (ZHS1 + ZHS2 ) / 2.;
       DL= 2P MOINS 1P ;
 INTSEG=(XHM * (COOR 1 DL)) + (YHM * (COOR 2 DL)) +(ZHM * (COOR 3 DL));
       VAL = EXTR HDL SCAL 1P ;
       VINT = VAL + INTSEG ;
*LIST (1P ET 2P);
*MESS 'VAL1P    INTSEG  VINT2P ' VAL  INTSEG  VINT  ;
*   le cas  ou 2p est ORIG   a ete exclu a l exterieur
       HDL= HDL + ( MANU CHPO 2P 1 SCAL  VINT  ) ;
 FINPROC HDL;
**** SAUT_POT             derniere modif  16/04/91
 DEBPROC  SAUT_POT FCAN*MAILLAGE FFER*MAILLAGE  LLLL*CHPOINT
          ORIG*POINT  ;
*  calcul du saut de potentiel
***************************************************************
*   relations entre points homologues   de la separation
*  orig est le point ou psi=phi=0.
*  attention a la coherence  avec  la condition limite
***************************************************************
 NNN= FCAN NBNO;
 IK= 0 ;ILO= 0 ;
 REPETER BLOC1 NNN;
 IK= IK + 1 ;
 IP=FCAN POINT IK ;IQ= FFER POINT PROCHE IP ;
 SI (NEG IP ORIG) ;
 RELP= RELA  1. T  IP - 1. T  IQ ;
 DEPIP= DEPIMP RELP (EXTR LLLL SCAL IP);
   SI (EGA ILO 0 ) ;
   REL1=RELP;  FDEPI= DEPIP ;
   ILO= 1 ;
   SINON ;
   REL2= REL1 ET RELP ;
   FDEPI2= FDEPI ET DEPIP ;
   DETR REL1 ; REL1= REL2 ; DETR FDEPI ; FDEPI= FDEPI2 ;
   DETR RELP ;DETR DEPIP ;
   FINSI;
 FINSI;
 FIN BLOC1 ;
 FINPROC  REL1 FDEPI;
**** B_ARETES                    derniere modif  16/04/91
 DEBPROC  B_ARETES  SEP_PHI*MAILLAGE ;
*    reduit un maillage surfacique  p1  a ses aretes
*  en conservant les doubles
 NBU= SEP_PHI NBEL ;
 DFCAN1 = SEP_PHI ELEM QUA4 ;NBQU= DFCAN1 NBEL ;
 MAILSEG= CONT ( DFCAN1 ELEM 1 );

  SI (NEG NBU NBQU);
  DFCAN2 = SEP_PHI ELEM TRI3  ; NTRI= DFCAN2 NBEL;
  I= 0 ;
  REPE BOUCSEGT NTRI;
  I = I + 1;
  MAILSEG = MAILSEG ET (CONT (DFCAN2 ELEM I));
  FIN BOUCSEGT;
  FINSI ;
  I= 1 ;
  REPE BOUCSEGQ  (NBQU - 1 );
  I = I + 1;
  MAILSEG = MAILSEG ET (CONT (DFCAN1 ELEM I));
  FIN BOUCSEGQ;
  TITRE 'MAILSEG ' (MAILSEG NBEL );
*  TRAC OEIL MAILSEG QUAL ;
  FINPROC MAILSEG ;

*
**** LIRBIOT            derniere modif  16/04/91
 DEBPROC LIRBIOT  SEP_PHI*MAILLAGE  MU0*FLOTTANT ;
***************************************************************
*               RECUP   BIOT ET SAVART SUR FRONTIERE
*  genere en exterieur  la surface frontiere a ete sortie pas sort
*   noopt precedement et a servi a calculer hs
*  on recupere le tout  coordonnees et hs  et on elmine pour etre sur
*  du support  (ordre )
***************************************************************
 NFN=SEP_PHI NBNO ;
 IMET= 2 ;
             SI ( EGA IMET 1);
 OPTION ACQUERIR  9 ;

 ACQUERIR   HX*LISTREEL  NFN
            HY*LISTREEL  NFN
            HZ*LISTREEL  NFN ;
   HS= MANU CHPO SEP_PHI 3  'HX' HX  'HY' HY  'HZ' HZ ;
  SINON ;

*   AUTRE   FACON A ESSAYER
*
 PPRO= PROG NFN  * 0 ;
 HS= MANU CHPO SEP_PHI 3 'HX' PPRO 'HY' PPRO 'HZ' PPRO ;
 OPTION ACQUERIR  8 ;
 IP= 0;
 REPETER BOUCA NFN ;
 ACQUERIR  X*FLOTTANT Y*FLOTTANT Z*FLOTTANT
          HX*FLOTTANT  HY*FLOTTANT  HZ*FLOTTANT  ;
* X= EXTR VALP 1 ;Y= EXTR VALP 2 ; Z= EXTR VALP 3;
* HX= EXTR VALP 4 ;HY= EXTR VALP 5 ; HZ= EXTR VALP 6;
  P1= X Y Z ; PT= SEP_PHI POINT PROCHE P1 ;
  HP= MANU CHPO PT 3 'HX' HX 'HY' HY 'HZ' HZ ;
  HS2 = HS + HP  ; DETR HS ; HS= HS2 ;
*tc mise en commentauire du finsi ci dessou
*  FINSI ;
*
 FIN BOUCA;
         FINSI;
*    provisoire   chambob  donne  B on divise par mu0
 HS= HS / MU0 ;
* ELIM .1 SEP_PHI PT ;
 FINPROC HS  ;
**** FOR_CONT                  derniere modif  16/04/91
 DEBPROC FOR_CONT CCONT*MAILLAGE SOL1*CHPOINT COURI*FLOTTANT;
*  calcul des forces par integrale de contour
 OBSEG = CCONT AFFECT ( MODELE STANDARD ) SEG2 ;
 AA = PRCH OBSEG SOL1 'GRAVITE';
 NBSEG = CCONT NBEL ;
 IEL = 0 ;SOMX = 0. ; SOMY = 0. ;SMM = 0. ;
*
 REPETER BOUC NBSEG ;
 IEL = IEL + 1 ; SEGC= CCONT ELEM IEL ;
 I1 = SEGC POINT INITIAL ; I2 = SEGC POINT FINAL ;
 X1 = COOR 1 I1 ; X2 = COOR 1 I2 ; RX = ( X1 + X2) / 2. ;
 Y1 = COOR 2 I1 ; Y2 = COOR 2 I2 ; RY = ( Y1 + Y2) / 2. ;
 DX = X2 - X1 ; DY = Y2 - Y1 ;
 AME = EXTR AA 'SCAL'  1 IEL 1 ;
 SOMX = SOMX + ( AME * DX) ;
 SOMY = SOMY + ( AME * DY) ;
 MOMM = (RX * DX) + (RY * DY ) ;
 SMM= SMM + ( AME * MOMM ) ;
 FIN BOUC ;
*
 FXX = COURI * SOMY ; FYY = -1. * COURI * SOMX ;
 MOMT = -1. * COURI * SMM ;
 CDG1 = BARY CCONT ;
 RFORC = MANU CHPO CDG1 2 'FX' FXX 'FY' FYY ;
 FINPROC RFORC SMM ;
**** FORBLOC             derniere modif  16/04/91
    DEBPROC  FORBLOC  BLOC*MAILLAGE BX*CHAMELEM BY*CHAMELEM
                  OBJO*MMODEL  COUR*FLOTTANT ;
*   bobi  maillage  non complexe
*   bb  champ induction AUX CDG   du maillage  reduit
*  integration de j vectoriel b  sur les elements  resultats aux cdg
*      sort un champ par points aux cdgs   dans rfor
*      sort un champ par point aux noeuds  dans rpt
  NNN= BLOC NBEL ;
  IP= 0 ;IPAS= 0 ;
  REPETER BOUE NNN  ;
  IPAS= IPAS + 1 ;
  IP  = IP + 1 ;  IEL =BLOC ELEM IP ;CDG= BARY IEL ;
  EL_SUR= MAXI (RESU (SOURCE OBJ0 COUR IEL ));
  FEX= (EXTR BY 'SCAL' 1 IP 1 ) * EL_SUR;FEX= FEX * -1. ;
  FEY= (EXTR BX 'SCAL' 1 IP 1 ) * EL_SUR;
    R_F= MANU CHPO CDG 2  'FX' FEX 'FY' FEY  ;
    NNI = IEL NBNO ;
    RFXP= MANU CHPO IEL 1 'FX' ( PROG  NNI * ( FEX / NNI )) ;
    RFYP= MANU CHPO IEL 1 'FY' ( PROG  NNI * ( FEY / NNI )) ;
    SI ( EGA IP 1) ;RFOR = R_F ;RPX = RFXP ;RPY=RFYP ;
    SINON ;
    RFOR  = RFOR + R_F ;RPX= RPX + RFXP ; RPY= RPY + RFYP ;
    FINSI ;
*  SI ( EGA IPAS 10 ) ;MESS 'menage';MENAGE ; IPAS = 0 ; FINSI ;
  RPT= RPX + RPY ;
  FIN  BOUE ;
*
 FINPROC RFOR RPT ;
**** INDUCTIO                    derniere modif  fevrier/92
******************************************************************
 DEBPROC INDUCTIO GEO*MAILLAGE  SOL1*CHPOINT  AXI*LOGIQUE   ;
****************************************************************
*                 2D  UNIQUEMENT
*          calcul; de l induction  en potentiel vecteur        *
*          GEO  maillage sur lequel on recherche B             *
*          SOL1   solution en potentiel vecteur                *
*          AXI    logique  vrai si axi                         *
****************************************************************
 OBJ0 = GEO MODL THERMIQUE ISOTROPE ;
 GRA_ELR = GRAD OBJ0 SOL1 ;
 DERIV  =  CHAN CHPO GRA_ELR OBJ0 ;
              SI (  AXI  ) ;
 IMET = 2 ;
           SI ( EGA IMET 1 ) ;
 mess '* methode 1';
 1SRAY = MUAXI2 GEO  1.  1 ;
          FINSI ;
          SI ( EGA IMET 2 ) ;
 1SRAY = MUAXI2 GEO  1.  2 ;
          FINSI ;
 mess '*  axisymetrique   methode 'imet   ;
 BX = ((EXCO DERIV 'T,Y')  * 1SRAY * -1. ) NOMC 'BX' ;
 BY = ((EXCO DERIV 'T,X' ) * 1SRAY ) NOMC  'BY' ;
              SINON ;
 mess '*  probleme plan   ';
 BX = (EXCO DERIV 'T,Y')   NOMC 'BX' ;
 BY = (( EXCO DERIV 'T,X' )* -1.)  NOMC  'BY' ;
              FINSI ;
 BTOT = BX + BY  ;
 FINPROC BTOT  ;
**** POT_VECT                derniere modif  1/03/92
 DEBPROC POT_VECT  MATAB*TABLE   SOLIN/MOT ;
********************************************************************
*        MAGETOSTATIQUE  2D  EN POTENTIEL VECTEUR                  *
********************************************************************
*      MATAB  TABLE D ENTREE CONTENANT
*    MATAB.'MU0'     PERMEABILITE DE L AIR (PAR DEFAUT UNITE METRE *
*    MATAB.'MUREL'   MU RELATIF DEPART   2900 PAR DEFAUT           *
*    MATAB.'AIR'     PARTIE AIR  NON   REDUITE A UN SUPER ELEMENT  *
*    MATAB.'FER'     FER                                           *
*    MATAB.'MAITRES'   POINT MAITRES SI SUPER ELEMENT              *
*    MATAB.'AIRSUP'  PARTIE AIR  TRAITEE EN SUPER (NON OBLIGATOIRE)*
*    MATAB.'ENCS '   LIMITE A A NULL  SUR LE SUPER ELEMENT (MAILL) *
*    MATAB.'BLOCAGE' LIMITE A A NULL SUR LA ZONE  STANDARD( MAILL) *
*    MATAB.'COUR'   TABLE  DE TABLES CONTENANT LA DESCRIPTION DES  *
*                   BLOCS DE COURANTS   CONSTITUEE PAR UN OU DES   *
*                   APPEL(S) A LA PROCEDURE DESCOUR                *
*    MATAB.'AXI' =  VRAI     SI PROBLEME AXISYMETRIQUE             *
*    SOLIN   MOT OPTIONNNEL  POUR LE CALCUL DU PREMIER PAS LINEAIRE*
********************************************************************
*        EN SORTIE MATAB CONTIENT LES OBJETS NECESSAIRES           *
*           AU CALCUL NON LINEAIRE                                 *
*    ET LA SOLUION DU PREMIER PAS SI DEMANDEE  DS MATAB.'POTENTIEL *
********************************************************************
  AXI= FAUX ;
   SI ( EXISTE MATAB 'AXI' ); AXI = MATAB.'AXI' ; FINSI ;
 MUAIR = 4 * PI * 1.E-7 ;
   SI ( EXISTE  MATAB 'MU0') ;MUAIR = MATAB.'MU0' ;FINSI ;
   SI ( EXISTE  MATAB 'MUREL' ) ;
      MUFER = MUAIR * (MATAB.'MUREL') ;
   SINON ; MUFER = MUAIR * 2900 ;
   FINSI ;
 MATAB.'MUAIR'= MUAIR ;
 AIR = MATAB.'AIR' ;
 FER = MATAB.'FER' ;
 OBJ1=MODL AIR  THERMIQUE ISOTROPE ;
 OBJ2=MODL FER  THERMIQUE ISOTROPE ;
   SI ( AXI ) ;
 MAT1= MUAXI2  AIR  MUAIR  1;
 MAT2= MUAXI2  FER  MUFER  1;
   SINON ;
*             rectification  conductibilites
 MAT1= MATR OBJ1  'K' ( 1. / MUAIR ) ;
 MAT2= MATR OBJ2  'K' ( 1. / MUFER ) ;
   FINSI ;
   SI ( EXISTE MATAB 'AIRSUP') ;
 AIRSUP = MATAB.'AIRSUP' ;
 OBJ3=MODL AIRSUP  THERMIQUE ISOTROPE ;
    SI ( AXI ) ;
 MAT3 = MUAXI2  AIRSUP MUAIR  1 ;
    SINON;
 MAT3= MATR OBJ3  'K' ( 1. / MUAIR ) ;
    FINSI ;
      SI ( EXISTE MATAB 'ENCS' );
      RIGB= (CONDUC OBJ3 MAT3 ) ET ( BLOQUER (MATAB.'ENCS' )  T ) ;
      SFAC = MATAB.'MAITRES';
      SUP1 = SUPER 'RIGIDITE' RIGB SFAC ;
      MATAB.'SUPER' = SUP1 ;
      FINSI ;
   FINSI ;
 RIGA= CONDUC OBJ1 MAT1 ;
 RIGF= CONDUC OBJ2 MAT2 ;
*
   SI ( EXISTE MATAB 'MAITRES') ;
 RIGCON= RIGA ET ( EXTRAI SUP1 'RIGI' );
   SINON ;
 RIGCON = RIGA ;
   FINSI ;
*                    charge
  TABCOUR = TABLE ;
  TABCOUR = MATAB.'COUR';
  III = INDEX TABCOUR ;
  IZ= 'ENTIER' 0 ;

  REPETER BOUC ;
  IZ= IZ + 1 ;
    SI ( 'NON'  ('EXISTE' III IZ )) ;QUITTER BOUC ; FINSI ;
    STN = TABCOUR.IZ ;GEO = STN.'GEO' ;
    FEIZ = SOURCE OBJ1 1.  GEO  ;
    SSS = EXTR (RESU FEIZ)  'Q' (( EXTR  FEIZ MAIL ) POINT 1);
*
    SI ( EXISTE STN 'AMP' ) ;
        J = STN.'AMP' ;
        STN.'AT' = SSS * J ;
        SINON ;
        SDO = STN.'AT' ;
        J = SDO / SSS ;
        STN.'AMP'= J ;
        FINSI ;
*
        FEIZ = FEIZ * J  ;
*
 MESS ' BLOC  '  IZ  '  JAMP ' J ' NI'  STN.'AT'  ;
     SI ( EGA IZ 1 ) ; FE = FEIZ ; SINON ;
    FE = FE + FEIZ ;
     FINSI ;
   FIN BOUC ;

 MATAB.'RHS'= FE ;

 MATAB.'RIGCON'= RIGCON;
 MATAB.'RIGFER'= RIGF;
     SI ( EXISTE SOLIN ) ;
 MESS '  *****************************************************';
 MESS '  *       CALCUL DE LA SOLUTION LINEAIRE              *';
 MESS '  *****************************************************';
       SI ( EXISTE MATAB 'BLOCAGE' );
  BBB = BLOQUER ( MATAB.'BLOCAGE') T ;
  MATAB.'BLOCAGE'= BBB ;
  SOL1= RESOU ( RIGF ET RIGCON ET BBB ) (MATAB.'RHS')  ;
       SINON ;
  SOL1= RESOU ( RIGF ET RIGCON ) (MATAB.'RHS')  ;
       FINSI ;
  MATAB.'POTENTIEL'= SOL1 ;
     FINSI ;
*
   FINPROC ;
**** DESCOUR              derniere modif  16/04/91
 DEBPROC DESCOUR  TAB*TABLE I*ENTIER  BLOCI*MAILLAGE   MM*MOT
                             J*FLOTTANT ;
*******************************************************************
*       DESCRIPTION D UNE ZONE DE COURANTS                        *
*       TAB   TABLE   QUI CONTIENDRA LE DESCIPTIF DE TOUTES LES   *
*                          ZONES DE COURANTS                      *
*       I        NUMERO D ORDRE  DE LA ZONE DE COURANT            *
*       BLOCI    ZONE DE COURANT TYPE MAILLAGE                    *
*       MM       MOT   'AMP'  OU  'AT'                            *
*       J        FLOTTANT   DENSITE DE COURANT OU AMPERES TOURS   *
*******************************************************************
 STN= TABLE ;
 STN.'GEO'= BLOCI ;
     SI ( EGA MM 'AMP') ;
     STN.'AMP' =  J ;
     SINON ;
     STN.'AT' = J ;
     FINSI ;
 TAB.I= STN ;
 FINPROC ;
**** MAG_NLIN             derniere modif  16/04/91
 'DEBPROC' MAG_NLIN  ETAB*'TABLE  '    ;
*----------------------------------------------------------------------*
*                                                                      *
*   INSPIRE  DE TRANSIT1                                               *
*   POUR TENIR COMPTE DE PLUSIEURS MATERIAUX DONT UN NON LINEAIRE      *
*   POUR TRAITER     PB  MAGNETOSTATIQUE                               *
*                             ---------------                          *
*                                                                      *
*     RESOLUTION D'UN PROBLEME DE MAGNETOSTATIQUE  NON-LINEAIRE        *
*     EN REGIME PERMANENT,A L'AIDE DE LA METHODE DU POINT FIXE         *
*     ETAB, TABLE CONTENANT EN ENTREE :                                *
* OBLIGATOIRE                                                          *
*     INDICE 'SOUSTYPE'     THERMIQUE                                  *
*     INDICE 'AXI '   LOGIQUE VRAI   EN 2D  SI AXISYM ( PLAN DEFAUT)   *
*                                                                      *
*     INDICE 'EVOCOND'      EVOLUTION DE Mu  CREE PAR LA PROCEDURE H_B *
*  QUI REND LA COURBE AD HOC POUR POT VECT OU POT SCALAIRE             *
* OPTIONNEL                                                            *
*     INDICE 'CRITERE'      CRITERE DE CONVERGENCE                     *
*     INDICE 'OME'          COEFF AMORTISSEMENT OSCI  0< OME < 1.      *
*                           (10E-5 PAR DEFAUT)                         *
*     INDICE 'NITER'        REACTUALISATION DE LA CONDUCTIVITE TOUTES  *
*                           LES NITER ITERATIONS (NITER=1 PAR DEFAUT)  *
*     INDICE 'NIVEAU'       NIVEAU DE MESSAGES (NIVEAU=0 PAR DEFAUT)   *
*     INDICE 'ITERMAX'      NOMBRE D'ITERATIONS MAXIMUM                *
*                           (ITERMAX=10 PAR DEFAUT)                    *
************************************************************************
*  arguments fabriques dans les passages soit ds pot_vect ou pot_scal  *
*     INDICE 'FLUX'         FLUX EQUIVALENTS                           *
*     INDICE 'BLOCAGE'      MATRICE DE BLOCAGE (CREEE PAR "BLOQUE")    *
*     INDICE 'IMPOSE'       VALEURS IMPOSEES (CREE PAR "DEPI")         *
*     INDICE 'RIGCON '      RAIDEUR CONSTANTE                          *
*     INDICE 'RIGFER '      RAIDEUR VARIABLE                           *
*     ETAB CONTENANT EN SORTIE :                                       *
*                                                                      *
*     INDICE 'POTENTIEL'    POTENTIEL  RESULTAT                        *
*                                                                      *
*     D.R., LE 7 JUILLET 1988.VERSION DU 18 JANVIER 1989.              *
*     MODIFIE PAR  BAZE    MAI 90
*----------------------------------------------------------------------*
 CONVERGE = FAUX ;ETAB.CONVERGE= FAUX ;
'REPETER' PROC 1 ;
'SI' ( 'NEG' ( ETAB.'SOUSTYPE' ) 'THERMIQUE' ) ;
   'MESS' 'SOUS TYPAGE INCORRECT DE LA TABLE EN ENTREE|' ;
   'QUITTER' PROC ;
'FINSI' ;
'SI' ( 'EXISTE' ETAB 'NIVEAU' ) ;
   NIV_MESS = ETAB.'NIVEAU' ;
'SINON' ;
   NIV_MESS = 0 ;
'FINSI' ;
'SI' ( NIV_MESS '>EG' 1 ) ;
   'SAUTER' 1 'LIGNE' ;
   'MESS' '***  DEBUT DE LA PROCEDURE "MAG_NONLIN"  ***' ;
'FINSI' ;
*
*---  RECUPERATION DE L'INFORMATION CONTENUE DANS "ETAB"
*
 'SI' ('EXISTE' ETAB BLOCAGE );
 MAT_BLO  = ETAB.'BLOCAGE'  ;
 'FINSI';
 RIG_CON  = ETAB.'RIGCON';
 'SI' ( 'EXISTE' ETAB 'IMPOSE' );
 VAL_IMPO = ETAB.'IMPOSE'   ;
 'FINSI' ;
*  IL FAUT EXTRAIRE LE FER ;
 FER = EXTRA ( ETAB.RIGFER )  MAIL;
     AXI = FAUX ;
     SI ( EXISTE ETAB 'AXI') ; AXI = ETAB.'AXI' ;FINSI ;
     SI AXI ;
  obmod =  MODL  FER THERMIQUE ISOTROPE   ;
  cp_rpoa = (coor 1 FER  )  ;
  ce_rpoa = CHAN 'CHAM' CP_RPOA  OBMOD 'GRAVITE';
  RFER = CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa );
     FINSI ;
* SI ( EXISTE ETAB 'SUPER' ) ;
 MAIL_CHP= FER ET ( EXTRA RIG_CON MAIL );
* SINON ;
* MAIL_CHP=  ETAB.'GEORED' ;
* FINSI ;
  NBRE_NOE = 'NBNO' MAIL_CHP ;
 VEC1= MANU CHPO MAIL_CHP 1 'T' (PROG NBRE_NOE * 1. ) ;
 QTE_FLUX = ETAB.'RHS'  ;
   EVO_COND = ETAB.'EVOCOND' ;
   LIS_COND = 'EXTRAIRE' EVO_COND 'CONDUCTIVITE' ;
   LIS_TEMP = 'EXTRAIRE' EVO_COND 'TEMPERATURE' ;
   VAL_COND=EXTR LIS_COND 1 ;
* SAUTER 3 LIGNES ;
* MESS '  CONDUCTIVITE INITIALE DU FER ' VAL_COND ;
 SAUTER 3 LIGNES ;
'SI' ( 'EXISTE' ETAB 'CRITERE' ) ;
   EPSILON  = ETAB.'CRITERE'  ;
'SINON' ;
   EPSILON = 1.E-5 ;
'FINSI' ;
'SI' ( 'EXISTE' ETAB 'NITER' ) ;
   NBRE_ITE = ETAB.'NITER' ;
   'SI' ( NIV_MESS '>EG' 1 ) ;
      'SAUTER' 1 'LIGNE' ;
      'MESS' 'REACTUALISATION DE LA MATRICE DE CONDUCTIVITE A L ENTREE '
             'PUIS TOUTES LES ' NBRE_ITE 'ITERATIONS' ;
   'FINSI' ;
'SINON' ;
   NBRE_ITE = 1 ;
'FINSI' ;
'SI' ( 'EXISTE' ETAB 'ITERMAX' ) ;
   ITER_MAX = ETAB.'ITERMAX' ;
'SINON' ;
   ITER_MAX = 10 ;
'FINSI' ;
**************************
OBJ_MFER = 'MODL' FER 'THERMIQUE' 'ISOTROPE' ;
'SI' ( 'EXISTE' ETAB 'IMPOSE');
 FF1 = QTE_FLUX 'ET' VAL_IMPO ;
'SINON';
 FF1 = QTE_FLUX;
'FINSI';
             ome= ETAB.'OME' ;
  'SI'  ('NON' ( 'EXISTE' ETAB 'POTENTIEL')) ;
 MESS '*************************************************************';
 MESS '************** CALCUL INITIAL *******************************';
 MESS 'SUPPOSE UN PASSAGE PREALABLE AU MOINS DS POT_VECT OU POT_SCAL';
 MESS '*************************************************************';
      klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
   SI ( AXI ) ;
     KLAST  = (KLAST * ( RFER ** -1. ))  ;
     CHAM_CND = CHAMELEM FER (KLAST 'NOMC' 'K')  'CARACTERISTIQUES';
   SINON ;
       CHAM_CND='MATR' OBJ_MFER  'K' VAL_COND ;
   FINSI ;
       CND1 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
      'SI' ( 'EXISTE' ETAB BLOCAGE ) ;
      RIG1 = CND1 ET RIG_CON ET MAT_BLO ;
      'SINON';
      RIG1 = CND1 ET RIG_CON  ;
      'FINSI' ;
       U1_T = 'RESOUDRE' RIG1 FF1 ;
       ETAB.'POTENTIEL'= U1_T  ENLEVER LX ;
*      CI= (LUMP RIG1 ) * VEC1 ; C2= (LUMP RIG1 ( MOTS T )) * VEC1  ;
*      CI = (C2 - CI ) NOMC 'SCAL';
   SINON ;
   MESS  '  ******************************************************';
   MESS  '  ******************       REPRISE     *****************';
   MESS  '  ******************************************************';
      SI (EXISTE  ETAB 'KLAST') ;
       KLAST= ETAB.'KLAST' ;
      SINON ;
      klast= manu chpo fer 1 'SCAL' ( prog ( fer nbno ) * val_cond );
      FINSI ;
       U1_T = 'EXCO' ( ETAB.'POTENTIEL')  'T' 'NOID' 'T' ;
*       CI = ETAB.'CI' ;
   MESS ' menage ' ; MENAGE ;
  FINSI ;
        'SI' ( NIV_MESS '>EG' 2 ) ;
        'SAUTER' 1 'LIGNE' ;
        'MESS' 'CHAMP THERMIQUE AVANT ITERATION ' ;
        'LISTE' U1_T ;
        'FINSI' ;
      DAN= 1.;
*
       MOESP='REA' ;
*
 MESS '            AMAX         AMIN          DU/U ';
*
***********************************************************
*---                          ... ITERATIONS ...
***********************************************************
NUM_ITE = 0 ;
IFOIS = 0 ;
'REPETER' BOUC_1 ;
   NUM_ITE = NUM_ITE + 1 ;
   IFOIS = IFOIS + 1 ;
*
*   calcul du champ dans le fer  ----->  modif de  mufer
      U1_FER=REDU U1_T  FER ;
      DERIV= CHAN  CHPO ( GRAD OBJ_MFER  U1_FER) OBJ_MFER;
                  SI ( AXI ) ;
                  DERIV = DERIV / RFER ;
                  FINSI ;
      SI (EXISTE  DERIV  'T,Z' ) ;
        DAX= (EXCO DERIV 'T,X') NOMC SCAL;
        DAY= (EXCO DERIV 'T,Y') NOMC SCAL;
        DAZ= (EXCO DERIV 'T,Z') NOMC SCAL;
        BB= (( DAY * DAY ) + ( DAX * DAX ) +( DAZ * DAZ )) ** .5 ;
        BB= BB NOMC T ;
      SINON ;
        DAX= (EXCO DERIV 'T,X') NOMC SCAL ;
        DAY= (EXCO DERIV 'T,Y') NOMC SCAL ;
        BB= ((( DAY * DAY ) + ( DAX * DAX ) ) ** .5 ) NOMC T ;
      FINSI ;

      BMAX= MAXIMUM  BB ;BMIN= MINI BB ;
      MESS IFOIS  MOESP '  ** CHAMP MAXI  MINI  FER '  BMAX BMIN ;
*      SAUTER 1 LIGNE ;

      K1 = 'IPOL' BB  LIS_TEMP LIS_COND ;
      K1=  COLI (K1 NOMC 'SCAL') OME    KLAST (1. -  OME)   ;
      KLAST = K1 ;
      K2 = 'NOMC' 'K' K1 ;
        SI ( AXI ) ;
       K2  = (K2 * ( RFER ** -1. )) NOMC 'K' ;
       CHAM_CND = CHAMELEM FER K2  'CARACTERISTIQUES';
        SINON ;
       CHAM_CND = 'CHAMELEM' FER K2 'CARACTERISTIQUES' ;
        FINSI ;
      CND2 = 'CONDUCTIVITE' OBJ_MFER CHAM_CND ;
      RR2= CND2 ET RIG_CON  ;
      RESID= ( FF1 - ( RR2 * U1_T )  )  ENLEVER 'FLX' ;
*
*                           tests  de convergence
*
   RESID= RESID NOMC 'SCAL';
   NORES= (XTX RESID )  ** .5 ;
       ERRMAX= MAXI ( ABS RESID ) ;
   MAXA= MAXI U1_T ;MIXA= MINI U1_T ;
   DETR RESID ;
 MESS IFOIS  MAXA MIXA    DAN ;
*
*
   'SI'  (( NUM_ITE 'EGA' NBRE_ITE ) 'OU'
            ( IFOIS 'EGA' 1 ) );
*****************************************************************
* ---  REACTUALISATION DE LA MATRICE DE CONDUCTIVITE
*****************************************************************
       MOESP='REA' ;
*      CI= (LUMP RR2 ) * VEC1 ; C2= (LUMP RR2 ( MOTS T )) * VEC1  ;
*      CI = (C2 - CI ) NOMC 'SCAL';
      'SI' ( 'EXISTE' ETAB BLOCAGE );
      RIG1 = RR2  ET MAT_BLO ;
      'SINON';
      RIG1 = RR2 ;
      'FINSI' ;
      U2 = 'RESOUDRE' RIG1 FF1 ;
      NUM_ITE = 0 ;
   'SINON' ;
*****************************************************************
* ---  RE-EQUILIBRAGE DU SECOND MEMBRE
*****************************************************************
      MOESP='   ' ;
      FF2 = ( RIG1  * U1_T ) - ( RR2 * U1_T ) ;
      FF3 = FF1 + FF2 ;
      U2 = 'RESOUDRE' RIG1 FF3 ;
*     'DETR' CND2 ;DETR RR1 ; DETR RR2 ;
   'FINSI' ;
*****************************************************************
*****************************************************************
   U2_T = 'EXCO' U2 'T' 'NOID' 'T' ;
*
   'SI' ( NIV_MESS '>EG' 2 ) ;
      'SAUTER' 1 'LIGNE' ;
      'MESS' 'CHAMP THERMIQUE A L ITERATION :' IFOIS ;
      'LISTE' U2_T ;
   'FINSI' ;
*
      CDIF= U2_T - U1_T ;
      DAN= (XTX  CDIF)  / ( XTX U1_T) ;
      DAN  = DAN  ** .5 ;
*
*        'SI' ( ERROR   < EPSILON ) ;
        'SI' ( DAN    < EPSILON ) ;
         CONVERGE = VRAI ;
         'SINON' ;
         CONVERGE = FAUX ;
         'FINSI' ;
*
*---  LE CRITERE DE CONVERGENCE EST-IL SATISFAIT ?
     MENAGE  ;

   'SI' ( CONVERGE ) ;
      'SI' ( NIV_MESS '>EG' 1 ) ;
*         'SAUTER' 1 'LIGNE' ;
         'MESS' 'CONVERGENCE A L ITERATION    :' IFOIS    ;
         'MESS' 'CRITERE DE CONVERGENCE       :' EPSILON  ;
      'FINSI' ;
      'QUITTER' BOUC_1 ;
   'FINSI' ;
   U1_T = U2_T ;
    'SI' ( 'EGA' IFOIS  ITER_MAX ) ;
*      'SAUTER' 1 'LIGNE' ;
      'MESS' 'PAS DE CONVERGENCE A L ITERATION :' ITER_MAX ;
       ETAB.CONV = CONVERGE  ;
      'QUITTER' BOUC_1 ;
   'FINSI' ;
*              ON FAIT LE MENAGE
 'FIN' BOUC_1 ;
        ETAB.NBITER= IFOIS;
*
*---  ARCHIVAGE DES RESULTATS DANS "ETAB"
*
 ETAB.'KLAST'= KLAST ;
 ETAB.'POTENTIEL' = U2_T ;
* ETAB.'CI'= CI ;
'SI' ( NIV_MESS '>EG' 1 ) ;
   'SAUTER' 1 'LIGNE' ;
   'MESS' '***  FIN DE LA PROCEDURE "MAG_NLIN"  ***' ;
'FINSI' ;
'FIN' PROC ;
'FINPROC' ETAB ;
************************
**** H_B                        derniere modif  16/04/91
 DEBPROC  H_B   MU0*FLOTTANT   POT_SCAL/MOT;
*     definition de la courbe  mu de b ou h
*  mu0   systeme  mksa  4 pi 10-7 ;
 MUVRA = 4. * 3.14159 * 1.E-7 ;RAP= MU0 / MUVRA ;
* B= PROG 0. 1.09 1.5 1.57 1.67 1.81 1.92  2.01  20.1  ;
* H= PROG 0. 300 800 1250 3000 8000 13000 20000  200000 ;

 B= PROG 0. .8 1.2 1.4 1.5  PAS .05 2.15 2.175 2.2 2.25 2.28 2.3 2.3443
 2.3996 2.4905 2.5627 2.6706 2.8498 3.2074 3.5644 4.2782 4.8134 5.7052
 6.4186 7.4887 17.48 27.48  200.  400. 600.  10000. 30000.;
 H= PROG 0. 159.2 294.4 501.3 795.8 1154. 1795. 2862. 4383. 6044. 8122.
 10590. 13610. 17220. 21170. 26750. 33760. 43800. 52440. 66000. 99470.
 120960. 141210. 169600. 212170. 283130. 339890. 425040. 566950. 850760.
 1134600. 1702300. 2128000. 2837700. 3405100. 4256700. 12215578.
  20174457. 155800000.  311600000. 467400000. 7.32E9  21.E9 ;
* TITRE  '  COURBE H  B  A/M  TESLAS  ****** ';
* BHEVO=EVOL MANU  'H'   H   'B' B ;
* DESS BHEVO;
*   RECTIF POUR COHERENCE UNITES
 H= H / RAP ;
 H_1=  ENLEVER H  1 ;B_1= ENLEVER B 1  ;
 MUV= H_1 / B_1;TU= EXTRA MUV 1;MUV= ( PROG TU )  ET MUV ;
 SI ('EXISTE' POT_SCAL );
 BOBO= TEXTE   ' MU  F(H)  POT SCAL ' ;
 TITRE BOBO ;
 REVOL = EVOL MANU 'TEMPERATURE ' H   'CONDUCTIVITE ' ( MUV ** -1.) ;
  SINON ;
 BOBO= TEXTE   '  MU  F(B) POT VECT ';
 TITRE BOBO ;
 REVOL=EVOL 'MANU' 'TEMPERATURE' B 'CONDUCTIVITE'  MUV   ;
 FINSI ;
 SAUTER 3 LIGNES ;
 MESS BOBO ;
 SAUTER 3 LIGNES ;
 FINPROC REVOL ;
*
**** POT_SCAL                        derniere modif  10/02/92
 DEBPROC POT_SCAL TABGEO*TABLE  SOLIN/MOT  ;
*********************************************************************
*    procedure  de mise en place des elements d un calcul 3d        *
*       magnetostatique  potentiel scalaire reduit et total         *
*            DPHI  zone de potentiel reduit                         *
*            DPsI  zone de potentiel total
***** desciption du domaine dphi   ( pas de super pour le moment)****
* TABGEO.'DPHI' =  geometrie   DPHI                                 *
* TABGEO.'SEPPHI'= surface de separation  appartient a DPHI
*    attention pour le moment on doit verifier l orientation de la  *
*    normale a sepphi ( exterieure ) en attendant extension de flux *
* TABGEO.'B_ANTI' = partie de sepphi appartenant a la limite        *
* TABGEO.'MUAIR'   =   mu0                                          *
*    d antisymetrie  pour  B                                        *
*******description du domaine dpsi **********************************
*  on donne  la descprition du fer puis une table tdolin  de tables *
*  contenant  chacune la descrition d un sous domaine               *
* TABGEO.'FER' =zone du fer  appartient a DPSI
* TABGEO.'MUFER' = mufer ( mu0 * murelatif)   valeur  de depart     *
* TABGEO.'TDOLIN'
*       TDOLIN.I = TABLE STN                                        *
*      STN.'GEO' =    maillage du sous domaine                      *
*      STN.'MU'  =    permeabilite
*        eventuellement                                             *
*      STN.'BLOCAGE'=   type maillage                               *
*      STN.'IMPOSE' =   type chpoint                                *
*      STN.'MAITRES' =  type maillage                               *
*                                                                   *
* TABGEO.'SEPPSI'= surface de separation appartient  a DPSI         *
* TABGEO.'ORIG'  = point ou on impose PHI = PSI                     *
* TABGEO.'BLOQUE' = condition limite generale (sauf super elements) *
* TABGEO.'BIOT' = table contenant le champ de la bobine sur DPHI    *
* TABGEO.'MAILSEG' =  elements d aretes  de sep_phi   (optionnel)   *
*    la routine l etablira si il n existe pas                       *
* TABGEO.'LISMO1'  = listmot de elements de volumes utilises        *
* TABGEO.'LISMO2'  = listmot de elements de surface utilises        *
*   SOLIN    si present  on calcule un  la solution lineaire        *
*            si absent le premier pas sera fait dans MAG_NLIN       *
*     jm baze    aout  90                                           *
*********************************************************************
 MU0  = TABGEO.'MUAIR' ;
    SI ( EXISTE TABGEO 'DPHI' ) ;
 MESS '*************************************************************';
 MESS '***********   POTENTIEL REDUIT ---- POTENTIEL TOTAL *********';
 MESS '*************************************************************';
 DPHI = TABGEO.'DPHI' ;
 SEP_PHI= TABGEO.'SEPPHI';
 B_ANTI = TABGEO.'B_ANTI';
 SEP_PSI= TABGEO.'SEPPSI';
 ORIG = TABGEO.'ORIG' ;
 TABHT= TABGEO.'BIOT';
 LIMO1= TABGEO.'LISMO1';
 LIMO2= TABGEO.'LISMO2';
*   reduction de biot et savart  sur sep_phi
 TABHS= TABLE ;
 TABHS.1 = REDU ( TABHT.1 ) SEP_PHI ;
 TABHS.2 = REDU ( TABHT.2 ) SEP_PHI ;
 TABHS.3 = REDU ( TABHT.3 ) SEP_PHI ;
 sauter 5 lignes  ;
 MMM= TEXTE ' THERMIQUE ISOTROPE  ';
 OBJPHI= MODL  DPHI  MMM;
 MATPHI= MATR OBJPHI  'K' MU0     ; RIGCON=CONDUC OBJPHI  MATPHI ;
 MESS '   COORD  POINT  ORIGINE INTEGRATION DE V ';
 LIST ORIG ;
 sauter 5 lignes  ;
 MESS ' CALCUL DU FLUX DE HS   SUR LES ELEMENTS FRONTIERE ';
 NBLD= DIMENSION  LIMO2  ;
 MESS ' FLUX DE HS  MU0 ';
      TTTT= EXTR LIMO2 1 ;TTTI= EXTR LIMO1 1 ;
      SEP_PHI1=SEP_PHI ELEM TTTI ;
      FLHS = FL_HS  SEP_PHI1   TABHS  TTTT OBJPHI ;
   SI ( EGA NBLD 2 ) ;
      TTTT= EXTR LIMO2 2 ;TTTI= EXTR LIMO1 2 ;
      SEP_PHI2=SEP_PHI ELEM TTTI ;
      FLHS2 = FL_HS  SEP_PHI2   TABHS  TTTT OBJPHI;
      FLHS = FLHS + FLHS2 ;
  FINSI ;
* TEMPS PLACE ;
 FLHS= FLHS * MU0 ;
 FLURED = RESU FLHS ;
 MESS ' RESULTANTE DU FLUX * MUO ' ( MAXI FLURED ) ;
 sauter 5 lignes ;
*   integration sur la surface de separation de l equation  de
*      de continuite tangentielle
     SI ( 'EXISTE'  TABGEO  'MAILSEG' ) ;
 MAILSEG= TABGEO.'MAILSEG';
     SINON ;
*    decomposition de la surface de separation en element d aretes
 MESS ' CALCUL DES  ELEMENTS ARETES  DE LA SEPARATION ';
 RESEAU= B_ARETES SEP_PHI ;
 imena = 50 ;
 MAILSEG = ARBRE  RESEAU   IMENA ;
 TABGEO.'MAILSEG'= MAILSEG  ;
     FINSI;
* TEMPS PLACE ;
 MESS '  CALCUL DU SAUT DE POTENTIEL  ';
 METHOD = 1 ;
 SAUTER 4 LIGNES ;
 IMENA= 3 ;
   SI (EGA METHOD 1) ;
   MESS  ' CALCUL PAR MINIMISATION ';
   LLLL= IN_MINI MAILSEG  TABHS ORIG B_ANTI ;
   SINON;
   MESS  ' CALCUL PAR INTEGRATION ';
   LLLL = ARBRE_IN  SEP_PHI TABHS  ORIG   ;
   FINSI ;
*****************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
  TABGEO.'LLLL'=LLLL ;
 MESS ' FIN DE CALCUL DU SAUT DE POTENTIEL ';
*
 SEP_PHI = CHAN POI1 SEP_PHI ;
 SEP_RED= DIFF SEP_PHI B_ANTI;
 LRED= REDU LLLL SEP_RED ;

  RELT FDEPI= SAUT_POT SEP_RED SEP_PSI LRED ORIG ;
 MESS ' FIN D APPLICATION DU SAUT DE POTENTIEL ';
*****************
  RIGCON = RIGCON ET RELT ;RHS = FLHS ET FDEPI ;
*****************
* LIST FSAUT ;
 sauter 5 lignes ;
*  TEMPS PLACE ;
      SINON ;
 SAUTER 5 LIGNES ;
 MESS '*************************************************************';
 MESS '***********   DPHI N EXISTE PAS --> POTENTIEL TOTAL *********';
 MESS '*************************************************************';
 SAUTER 5 LIGNES ;
      FINSI ;
**
 DFER = TABGEO.'FER' ;
 MUFER = TABGEO.'MUFER' ;

 OBJ2=MODL  DFER  MMM;
 MAT2= MATR OBJ2  'K' MUFER   ; RIGFER=CONDUC OBJ2 MAT2 ;
*       boucle sur les domaines lineaires  non contenus dans dphi
            SI ('EXISTE' TABGEO 'DOLIN' );
   TDOLIN = TABGEO.'DOLIN' ;
   III = INDEX TDOLIN ;
   IDOM = 0 ;
     REPETER BOUCDOM ;
   IDOM = IDOM + 1 ;
     SI ( 'NON' ( 'EXISTE' III IDOM )) ; QUITTER BOUCDOM ;FINSI ;
   STN = TDOLIN.IDOM ;
 LIST STN ;
   GEO = STN.'GEO' ;OBJI= MODL  GEO MMM ;
   MUI = STN.'MU'  ;
   MATI= MATR OBJI  'K' MUI     ; RIGO=CONDUC OBJI MATI ;
*
               SI ( EXISTE STN 'BLOQUE' ) ;
               ENC1 = BLOQUER  (STN.'BLOQUE') 'T';
               RIGO = RIGO ET ENC1 ;
               FINSI ;
                  SI ( EXISTE STN 'IMPOSE' ) ;
          CHIMP = (STN.'IMPOSE' ) NOMC 'T';
          MAII = EXTR  CHIMP  MAILLAGE ;
          RIMP = BLOQUER  MAII 'T'  ; FPOTI = DEPIMP  RIMP  CHIMP ;
             RIGO = RIGO ET RIMP ;RHS = RHS ET FPOTI ;
                  FINSI ;
        SI ( EXISTE STN  'MAITRES');
******************************************************************
*      construction  eventuelle du super element
******************************************************************
*               attention ici si il y a une charge  OU UN IMPOSE
  SUP1 = SUPER 'RIGIDITE' RIGO ( STN.'MAITRES' ) ;
  RIGCON   = RIGCON  ET ( EXTRA SUP1 'RIGI' ) ;
        SINON ;
  RIGCON = RIGCON  ET RIGO ;
        FINSI ;
   FIN BOUCDOM ;
*        fin de la boucle sur les table de domaines lineaires de dpsi
          FINSI ;
*
      SI( EXISTE TABGEO 'IMPOSE') ;
  MESS ' CONDITION GENERALE IMPOSEE ' ;
          CHIMG = (TABGEO.'IMPOSE' ) NOMC 'T';
          MAIG = EXTR  CHIMG  MAILLAGE ;
          RIMG = BLOQUER  MAIG 'T'  ; FPOTG = DEPIMP  RIMG  CHIMG ;
          RIGCON = RIGCON ET RIMG ;RHS = RHS ET FPOTG ;
      FINSI ;
*
      SI (EXISTE TABGEO 'BLOQUE') ;
  MESS ' CONDITION GENERALE BLOQUEE ' ;
           ENCG = BLOQUER  (TABGEO.'BLOQUE') 'T';
           RIGCON= RIGCON  ET ENCG ;
      TABGEO.'BLOCAGE' = ENCG ;
      FINSI ;
*
*
 SI ( EXISTE  SOLIN ) ;
 MESS '********************************************************* ';
 MESS '***************** CALCUL   LINEAIRE  ******************** ';
 MESS '********************************************************* ';

 RIGT = RIGCON ET RIGFER ;
 TABGEO.'RHS'= RHS ;
 TABGEO.'RIGCON'= RIGCON ;
 TABGEO.'RIGFER'= RIGFER ;
 SOL0= RESOU RIGT RHS ;
 TABGEO.'POTENTIEL'=(ENLEVER SOL0  LX) ;
 FINSI ;
*
  FINPROC   ;
**** A_HOMO              derniere modif  10/02/92
  DEBPROC A_HOMO  AKN*LISTREEL RHARM*FLOTTANT RCIRC*FLOTTANT
                 NHARM*ENTIER;
  SAUTER 2 LIGNES ;
 OPTION ELEM SEG2 ;
 BDIP= EXTR AKN 1;BQUAD = EXTR AKN 2 ;G0 = BQUAD  / RHARM ;
 SAUTER 2 LIGNES ;
 MESS '******************* BDIP ' BDIP ;
 MESS '******************* BQUAD' BQUAD;
 MESS '******************* G0   ' G0 ;
 SAUTER 2 LIGNES ;
 C2R = EXTR AKN 2  ;
  K= 0 ;
  REPETER BLOCC NHARM ;
  K= K + 1; COK = EXTR AKN K ;
  AKM=  COK  / ( RHARM ** (K - 1)) ;
  CQUA= COK  / C2R ;
  CDIP = COK / BDIP;
  MESS  K  AKM CQUA  ;
  FIN BLOCC ;
 SAUTER 2 LIGNES ;
* ON CONSTRUIT UN CHPO SUR LE RAYON ANALYSE CE QUI SERA PRATIQUE POUR
*   TRACER DES EVOLUTIONS ;
 OP = RCIRC 0.;OO= 0. 0. ;
 LSUP= D 10 OO  OP;
 NN= 11 ;
 DX =2.;
 X= -2. ;
 IP=0 ;
 REPETER BLOCA 11 ;
 IP= IP + 1 ;
 X =X + DX ; Z = X / RHARM ;
 B = 0 ; G = G0 ; BQUAD =  C2R * Z ;
 K= 0 ;
   REPETER BLOCB NHARM ;
     K= K + 1 ; COK = EXTR AKN K ;
  SI ( K EGA 1 ) ; B = B + COK ;SINON ;TERM= COK * ( Z ** (K - 1 ));
  B= B + TERM ;
       SI ( (K >EG 3 ) ET ( (ABS X ) >EG 1.E-4 ) );
       G = G + (( TERM / X ) * (K - 1)) ;
       FINSI ;
  FINSI ;
   FIN BLOCB ;
*  SI (( ABS X ) >EG 1.E-4 ) ;
 HQUAD= (B - BDIP - BQUAD ) /C2R ;
 GQUAD= (G - G0 ) / G0 ;
 HDIP = (B - BDIP) / BDIP ;
*  FINSI;
   SI ( IP EGA 1 ) ;
   LHQ= PROG HQUAD ;LG= PROG G ;
   LGQ = PROG GQUAD ; LB= PROG B;
   SINON ;
   LHQ= LHQ ET (PROG HQUAD ) ;LG= LG ET ( PROG G );
   LGQ = LGQ ET (PROG GQUAD );LB= LB ET (PROG B );
   FINSI ;
 FIN BLOCA ;
  SAUTER 2 LIGNES ;
 CX= COOR 1 LSUP ;

 TUTU= MANU CHPO  LSUP 4  'B' LB   'DB/B' LHQ 'G' LG  'DG/G' LGQ ;
 SAUTER 2 LIGNES ;
 MESS  '  ANALYSE   CONFORME  A  HARMBIS  ';
 SAUTER 2 LIGNES  ;
 RECAP = CX ET TUTU ;
 LIST RECAP ;
 FINPROC ;
*
**** INT_COMP                   derniere modif  janvier /92
 'DEBPROC'  INT_COMP   GEOP*MAILLAGE  CCCC*CHPOINT  GEOF*MAILLAGE ;
************************************************************************
*     interpolation d une composante sur un maillage                   *
*     TYEL  TYPE D ELEMENTS                                            *
*     entree cccc  chpoint original  a 1 composante  de support geop   *
*     sortie chpo  de support geof                                     *
************************************************************************
       TYT = VALE ELEM ;
          SI (  NON ( EGA TYT 'TRI3'));
          GEOP  = CHAN GEOP TRI3 ;
 MESS 'ON PASSE EN TRI3 POUR UTLISER PROI  ( DEGUEULASSE EN TRI6....)';
          FINSI ;

 OBS1 = AFFECT GEOP ( MODELE STANDARD ) TRI3 ;
 CEL1 = PRCH   CCCC  OBS1 'NOEUD' ;
 CRES = PROI  GEOF CEL1   ;
  FINPROC CRES ;
*
**** IDE_ELE                derniere modif fevrier/92
 DEBPROC IDE_ELE ;
**********************************************************************
*      IDENTIFICATION  DU TYPE D ELEMENTS  UTILISES
**********************************************************************
   TIDIM = VALE DIME ;
   TVAL  = VALE ELEM ;
   SI ( EGA TIDIM 2 ) ;
     SI (( EGA TVAL 'QUA8') 'OU' (EGA TVAL 'TRI6')) ;
     TYEL = TEXTE  'QUA8' 'TRI6' ;
     SINON ;
     TYEL = TEXTE 'QUA4' 'TRI3' ;
     FINSI ;
   SINON ;
     SI (( EGA TVAL 'CU20') 'OU' (EGA TVAL 'PRI16')) ;
     TYEL = TEXTE  'CU20' 'PR15' 'TET10';
     SINON ;
     TYEL = TEXTE  'CUB8' 'PRI6' 'TET4';
     FINSI ;
   FINSI ;
 FINPROC TYEL ;
**** MUAXI2                       MODIFIE  FEVRIER 92
 DEBPROC MUAXI2  GEO*MAILLAGE  MU*FLOTTANT  IDI*ENTIER ;
***********************************************************************
*   SORTIE  De CONDUCTIBILITE = 1/(MU*R) EN AXISYMETRIQUE             *
*           IDI = 1  sortie chamelem 'caracteristique au noeuds DEFAUT*
*           IDI = 2  sortie chpo  aux noeuds  scalaire                *
*           IDI = 3   sortie chamelem  au CDG                         *
*      MODIFIEE FEVRIER 92 POUR P2                                    *
***********************************************************************
  IMET = 2 ;
         SI ( EGA IMET 1 ) ;
*   estimation de  mu au noeuds en trichant sur l axe
 RGEO = COOR 1 GEO  ;
 AXE= GEO   POINTS DROITE (0. 0) (0. 10.) .05 ;
 MUPO = (((RGEO + ((COOR 1 AXE) + 1.E-8)) ** -1. ) / MU ) NOMC 'K';
  MATT= CHAMELEM GEO    MUPO  'CARACTERISTIQUE' ;
         FINSI  ;
         SI ( EGA IMET 2 ) ;
*   estimation de  mu aux cdg   sans tricher sur l axe
 OBMOD = MODL GEO THERMIQUE ISOTROPE ;
 cp_rpoa = (coor 1 GEO )  ;
*   chamelem des rayons aux cdg
 ce_rpoa = CHAN 'CHAM' CP_RPOA  OBMOD 'GRAVITE';
*   chamelem des cdg  reportes aux noeuds
 RGEO = (CHAN CHPO OBMOD (CHAN 'NOEUD' OBMOD ce_rpoa )) ** -1.;
        SI ( EGA IDI 1 ) ;
  CHPMUGEO= ( (1./ MU ) * RGEO )NOMC 'K' ;
  MATT= CHAMELEM GEO    CHPMUGEO  'CARACTERISTIQUE' ;
*  MESS ' 1/MU  CHAMP ELEM  TYPE  CARACTERISTIQUE  K ';
        FINSI ;
        SI (EGA IDI 2 ) ;
   MESS ' 1/R    AUX CDG REPORTES AUX   NOEUDS   SCALAIRE  ';
     MATT = RGEO    ;
        FINSI ;
        SI (EGA IDI 3 ) ;
   MESS ' 1/R   CHAMP ELEM AUX  CDG  ';
        MATT = CE_RPOA ;
        FINSI ;
            FINSI ;
 FINPROC MATT  ;
**** REMONT                    derniere  modif 14 08 91
 DEBPROC REMONT  ETAB*TABLE  POT*CHPOINT  GEON*MAILLAGE FE/CHPOINT
 GEOMAIT*MAILLAGE ;
*  POT SOLUTION
*  GEON  MAILLAGE AUTRE  QUE LE SUPER
* GEOMAIT   POINTS MAITRES
 SI ( EXISTE  ETAB  'SUPER' ) ;
 SUPP= ETAB.'SUPER' ;
 DSUP = SUPER 'DEPLA' SUPP  POT ;
*  ATTENTION SI IL Y AVAIT DES CHARGES DANS LE SUPER
 RIGS = EXTRAI SUPP 'RIGT'   ;
   SI ( EXISTE FE ) ;
 SOLSUP = RESOU   RIGS ( DSUP  ET FE ) ;
   SINON ;

 SOLSUP = RESOU   RIGS  DSUP   ;
   FINSI ;
 GEOSUP = EXTR SOLSUP  MAILLAGE  'NOMU' ;
 SINON ;
********************************************************
*   autre methode  eventuelle
********************************************************
*  TAIR2 = REDU SOL1 CAIR1 ;
*  NN= CAIR1 NBNO ;CAIR1 = CHAN CAIR1 POI1 ;
*  IP = 0 ;
*  REPETER BBBB NN ;
*  IP = IP + 1 ;PP = CAIR1 POINT IP ;
*  CLIM = BLOQUER 'T' PP ; FP = DEPIMP CLIM ( EXTR TAIR2 'T' PP ) ;
*  SI ( EGA IP 1 ); CLIMT = CLIM ;FPT = FP ;
*  SINON ; CLIMT = CLIMT ET CLIM  ; FPT = FPT ET FP  ;FINSI ;
*  FIN BBBB ;
*  TIAIR2 = RESOU   (RIGA ET CLIMT) ( FPT ET FE ) ;
  FINSI ;
*
  POIS= CHAN GEOSUP POI1 ;
  AAA= DIFF POIS   (CHAN GEOMAIT POI1 )   ;
  SOLSU = REDU SOLSUP  AAA  ;
  SOLT= ( POT  +  SOLSU  )  ;
  FINPROC SOLT  ;
**** F_S2PI                          derniere modif 30/3/92
 DEBPROC F_S2PI  CHARM*MAILLAGE SCIRC*CHPOINT  NN*ENTIER
                            OO*POINT ;
  VALIN = REDU SCIRC ( CHARM POINT INITIAL ) ;
  VALFI = REDU SCIRC ( CHARM POINT FINAL   ) ;
  V1 = MAXI VALIN ;V2 = MAXI  VALFI  ;
  K = -1  ;
     SI (( V1 < V2 )  ET ( NUM NEG 1 )) ;
     CHARM = INVE CHARM ;K = 1 ;
     FINSI ;
 1P = CHARM POINT INITIAL ;2P = CHARM POINT FINAL ;
 IP = 0 ;
 REPETER  BOUC (NN  - 1 );
 IP = IP + 1 ;
    SI ( EGA IP 1 ) ;
 SOL2 = (SCIRC PLUS (0. 0.)) * K  ;
    SINON ;
 SOL2 = (SOL2 PLUS  (0. 0.)) * K  ;
    FINSI ;
 MAI2 = EXTR SOL2 MAILLAGE ;
 PDOU = CHARM POINT FINAL ;
 VALDOU = REDU SCIRC  PDOU ;

 MAI2 =  DEPLACER MAI2 SYME DROITE OO PDOU     ;
     SI ( EGA IP 1 ) ;
 CHARM2= ( INVE (CHARM SYME DROITE OO PDOU )) ;
     SINON ;
 CHARM2= ( INVE (CHARM2 SYME DROITE OO PDOU )) ;
     FINSI ;
 ELIM .0001 CHARM2 MAI2 ;
 CONFONDRE ( CHARM POINT FINAL) ( CHARM2 POINT INITIAL ) ;
 CHARM = CHARM ET CHARM2 ;
 SCIRC = SCIRC + SOL2 - VALDOU  ;
 K = K * -1 ;
 FIN BOUC ;
*
 SUPO = CHARM ;
* TITRE ' SOLUTION SUR 2PI ';
* EVV1 = EVOL ROUG CHPO SCIRC 'T'  CHARM ;
* titre ' evo '( dime evv1 )  'supp ' ( supo nbno ) ;
* trac supo ;
* dess evv1 ;
 FINPROC SCIRC  SUPO ;
**** DDFOUR                 derniere modif  30/3/92
 DEBPROC  DDFOUR GEO*MAILLAGE CHARM*MAILLAGE  NHARM*ENTIER
  SOL*CHPOINT  RHARM*FLOTTANT  ORIG/POINT LIS*LOGIQUE ;
*********************************************************************
*        ANALYSE HARMONIQUE  DU POTENTIEL VECTEUR
*        GEO    MAILLAGE SUPPORT SOLUTION GENERALE                  *
*        CHARM  ARC DE CERCLE SUR LEQUEL ON A LE POTENTIEL          *
*        NHARM  NOMBRE D HARMONIQUES A CALCULER                     *
*        SOL  SOLUTION  EN POTENTIEL                                *
*        RHARM  RAYON DE NORMALISATION                              *
*        ORIG   ORIGINE CERCLE D ANALYSE
*        LIS LOGIQUE  FAUX SI PAS DE LISSAGE POLYNOMIAL             *
*********************************************************************
 1P = CHARM POINT INITIAL ;2P= CHARM POINT FINAL ;
        SI ( EXISTE ORIG ) ;
        RCIRC = NORM ( 1P MOINS ORIG ) ;
        SINON ;
        RCIRC = NORM 1P ;ORIG = 0. 0. ;
        FINSI ;
 X1 Y1 = COOR ( 1P MOINS ORIG );X2 Y2 = COOR 2P ;
 PT = 2P PROJETER (( Y1 * -1. )  X1 )  DROITE ORIG 1P ;
 H = NORM ( 2P MOINS PT ) ;
     SI ( (X1 + X2 ) < 1.E-3 ) ;
 NUM = 2 ;
 MESS   'SOLUTION DONNEE SUR  180  DEGRES ' ;
     SINON ;
 ANG = ATG H ( NORM ( PT MOINS ORIG)) ;
 NUM = ( ENTI ( 360.1 / ANG )) ;
 MESS   'SOLUTION DONNEE SUR ' ANG ' DEGRES '   ;
     FINSI ;
   SI ( NON ( LIS )) ;
 SCIRC = INT_COMP  GEO   SOL  CHARM    ;
 SCIRC = SCIRC NOMC 'T' ;
   SINON ;
* lissage polynomial
 CHLI  = LISS  GEO CHARM  SOL    2 PLAN ;
 SCIRC = (EXCO CHLI  'A' ) NOMC 'T' ;
   FINSI ;
 RRAP = RHARM / RCIRC ;
 CQTT RTOT = F_S2PI CHARM  SCIRC  NUM ORIG  ;
  EQTT = EVOL ROUG CHPO CQTT  'T' RTOT ;
  AAAA=  EXTR EQTT 'ABSC' ;
* QTOT=  EXTR EQTT 'ORDO' ;
* LIST QTOT ;
* NI1= (DIME AAAA ) - 1  ;
* IVAL = VALE ELEM ;
* OPTION ELEM SEG2 ;I1 = 0. 0. ; I2 = 360. 0. ;
* RTOT = DROI  NI1  I1 I2  ;
 OBA_RMA= AFFECTE RTOT (MODELE STANDARD) COQ2;
 PERIOD= MAXI AAAA ;
 MULT= 360. / PERIOD ;
 ANGVEC= AAAA * MULT  ;
* MESS ' PERIODE '  PERIOD ;
 N=0;
 MESS   '  ANALYSE CONFORME A POISSON  HARMON ';
 MESS   ' HARMONIQUE     POTENTIEL    CHAMP ';
 MESS ' NOMBRE DE SEGMENTS DE DR ' NI1 ;
 MESS ' DIME DE ANGVEC ' ( DIME ANGVEC ) ;
 CHPA= MANU CHPO RTOT 1 SCAL ANGVEC ;
* CQTT = MANU CHPO RTOT 1 'POT' QTOT ;
 REPETER BLOCIT NHARM ;
 N= N + 1 ;
 RAN= RRAP ** N ;
 ANGLEN= CHPA  *  N ;
 CNX=  COS  ANGLEN ;
 SNX=  SIN  ANGLEN ;
 EVREL= CQTT * CNX ;EVIMA= CQTT * SNX ;
 CEVREL = PRCH  EVREL OBA_RMA  'RIGIDITE' ;
 CEVIMA = PRCH  EVIMA OBA_RMA  'RIGIDITE' ;
 AK= (( INTG CEVREL ) / PERIOD ) * 2. * RAN ;
 BK= (( INTG CEVIMA ) / PERIOD ) * 2. * RAN ;
 CK= (( AK * AK ) + ( BK * BK ) ) ** .5 ;
 FF= ( FLOT N) / RHARM ;
 AKK= AK * FF ;
 BKK= BK * FF ;
 CKK= CK * FF ;
 SI (N EGA 1 );AKN= PROG AKK ; SINON ;AKN = AKN ET (PROG AKK ) ; FINSI ;
 SAUTER 1 LIGNE ;
* MESS   N AK BK CK AKK BKK CKK ;
 MESS   N   AK  BK  CK  ;
 MESS   N  AKK BKK CKK  ;
 FIN BLOCIT ;
* OPTION ELEM IVAL ;
 FINPROC AKN  ANGVEC ;
*****

**** @DEFMAT
DEBPROC @DEFMAT TAB1*TABLE                                    ;
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
************************************************************************
MESS '---------------------------------> Entree dans DEFMAT '     ;

* on initialise des evol nuls
EVMA1   = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. )          ;
EVMA2   = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. )          ;
EVMA3   = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. )          ;
EVMA4   = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. )          ;
EVMA5   = EVOL MANU ( PROG 0. 500.) ( PROG 0. 0. )          ;
CHP_TM1 = TAB1.>CHP_TM1                                     ;
TAB1.TETMAT          = TABLE                                ;
TAB1.MODL_MAT        = TABLE                                ;
TAB1.MAT_MAT         = TABLE                                ;

I1   =  0                                                   ;
REPETER BOMA11                                              ;
 I1 = I1 + 1                                                ;
*>1
 SI ( EXISTE (TAB1.ZONE_MAT)  I1 )                          ;
  NOM_MAT1 = TAB1.NOM_MAT.I1                                ;
  MESS '>>>> MATERIAU ' I1 NOM_MAT1                         ;
  TMECA_I1 = TEXT TAB1.TEXTMECA.I1                          ;
  MO1  = MODL TAB1.ZONE_MAT.I1   TMECA_I1                   ;
  TAB1.MODL_MAT. I1 = MO1                                   ;
  TITRE NOM_MAT1 ' YOUN MODULUS '                          ;
  TAB1.TETMAT.MO1         = TABLE                           ;

*>>2*************** orthotropie

  SI ( EGA TAB1.TEXTMECA.I1 ' MECANIQUE ELASTIQUE ORTHOTROPE') ;
   CHAYGI= CHAINE TAB1 . TEXTMECA .(I1 + 100)                  ;
   MESS '>>> ORTHOTROPIE' TAB1.TEXTMECA.I1                     ;
   MESS '>>> DIRECTIONS D ORTHOTROPIE' CHAYGI                  ;

*                     P1 = TAB1.DIRECT1                              ;
*                     P2 = TAB1.DIRECT2                              ;
*                     CHAYGI = 'DIRECTION P1 P2 '                    ;
*                     CHADIR = 'DIRECTION TAB1.DIRECT1 TAB1.DIRECT2' ;

   SI ( NON ( EXISTE TAB1 'MOMATR'))             ;
    TAB1.'MOMATR' = TABLE                        ;
   FINSI                                         ;
   TAB1.'MOMATR'.MO1 =  TAB1.TEXTMECA.(I1 + 100) ;

*                       CHAYG1   = CHAINE CHADIR ' YG1 '  ;
*                       CHAYG2   = CHAINE CHADIR ' YG2 '  ;
*                       CHAYG3   = CHAINE CHADIR ' YG3 '  ;
*                       CHAG12   = CHAINE CHADIR ' G12 '  ;
*                       CHAG23   = CHAINE CHADIR ' G23 '  ;
*                       CHAG13   = CHAINE CHADIR ' G13 '  ;
*                       CHANU12  = CHAINE CHADIR ' NU12 ' ;
*                       CHANU23  = CHAINE CHADIR ' NU23 ' ;
*                       CHANU13  = CHAINE CHADIR ' NU13 ' ;
*                       CHAALP12 = CHAINE CHADIR ' ALP1 ' ;
*                       CHAALP23 = CHAINE CHADIR ' ALP2 ' ;
*                       CHAALP13 = CHAINE CHADIR ' ALP3 ' ;

*>>3*************** orthotropie  333333333333333DDDDDDDDDD

   SI (EGA (VALEUR DIMENSION) 3 ) ;
    TAB1.TETMAT.MO1.YG1  = @EVMAT TAB1.NOM_MAT.I1   'YG1' TAB1  ;
    TAB1.TETMAT.MO1.YG2  = @EVMAT TAB1.NOM_MAT.I1   'YG2'  TAB1 ;
    TAB1.TETMAT.MO1.YG3  = @EVMAT TAB1.NOM_MAT.I1   'YG3'  TAB1 ;
    EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1
            ET TAB1.TETMAT.MO1.YG2  ET TAB1.TETMAT.MO1.YG3     ;
    TITRE NOM_MAT1 ' POISSON COEFFICIENT '             ;
    TAB1.TETMAT.MO1.NU12    = @EVMAT TAB1.NOM_MAT.I1   'NU12' TAB1  ;
    TAB1.TETMAT.MO1.NU23    = @EVMAT TAB1.NOM_MAT.I1   'NU23'  TAB1 ;
    TAB1.TETMAT.MO1.NU13    = @EVMAT TAB1.NOM_MAT.I1   'NU13'  TAB1 ;
    EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12 ET TAB1.TETMAT.MO1.NU23
            ET TAB1.TETMAT.MO1.NU13 ;
    TITRE NOM_MAT1 ' THERMAL EXPANSION '             ;
    TAB1.TETMAT.MO1.ALP1    = @EVMAT TAB1.NOM_MAT.I1   'ALP1' TAB1  ;
    TAB1.TETMAT.MO1.ALP2    = @EVMAT TAB1.NOM_MAT.I1   'ALP2' TAB1  ;
    TAB1.TETMAT.MO1.ALP3    = @EVMAT TAB1.NOM_MAT.I1   'ALP3'  TAB1 ;
    EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2
            ET TAB1.TETMAT.MO1.ALP3;
    TAB1.TETMAT.MO1.G12      = @EVMAT TAB1.NOM_MAT.I1   'G12'  TAB1 ;
    TAB1.TETMAT.MO1.G23      = @EVMAT TAB1.NOM_MAT.I1   'G23'  TAB1 ;
    TAB1.TETMAT.MO1.G13      = @EVMAT TAB1.NOM_MAT.I1   'G13'  TAB1 ;
    TM_1 =    ( REDU CHP_TM1 TAB1.ZONE_MAT.I1  )       ;
*
*** DIRECTION 1
*
    Y_1  = VARI  TM_1   TAB1.TETMAT.MO1.YG1  YG1 ;
    G_1  = VARI  TM_1   TAB1.TETMAT.MO1.G12  G12 ;
    N_1 = VARI  TM_1   TAB1.TETMAT.MO1.NU12  NU12   ;
    A_1 = VARI  TM_1   TAB1.TETMAT.MO1.ALP1  ALP1    ;
*
    N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE'                      ;
    Y_1   = CHANGER CHAM Y_1   MO1 'RIGIDITE'                       ;
    G_1   = CHANGER CHAM G_1   MO1 'RIGIDITE'                       ;
    A_1  = CHANGER CHAM A_1  MO1 'RIGIDITE'                       ;
*
*** DIRECTION 2
*
    Y_2   = VARI  TM_1   TAB1.TETMAT.MO1.YG2   YG2 ;
    G_2   = VARI  TM_1   TAB1.TETMAT.MO1.G23   G23 ;
    N_2 = VARI  TM_1   TAB1.TETMAT.MO1.NU23  NU23   ;
    A_2  = VARI  TM_1   TAB1.TETMAT.MO1.ALP2  ALP2    ;
*
    N_2 = CHANGER CHAM N_2 MO1 'RIGIDITE'                      ;
    Y_2   = CHANGER CHAM Y_2   MO1 'RIGIDITE'                       ;
    G_2   = CHANGER CHAM G_2   MO1 'RIGIDITE'                       ;
    A_2  = CHANGER CHAM A_2  MO1 'RIGIDITE'                       ;
*
*** DIRECTION 3
*
    Y_3 = VARI  TM_1   TAB1.TETMAT.MO1.YG3   YG3 ;
    G_3 = VARI  TM_1   TAB1.TETMAT.MO1.G13   G13 ;
    N_3 = VARI  TM_1   TAB1.TETMAT.MO1.NU13  NU13   ;
    A_3 = VARI  TM_1   TAB1.TETMAT.MO1.ALP3  ALP3    ;
*
    N_3 = CHANGER CHAM N_3 MO1 'RIGIDITE'                      ;
    Y_3 = CHANGER CHAM Y_3 MO1 'RIGIDITE'                       ;
    G_3 = CHANGER CHAM G_3 MO1 'RIGIDITE'                       ;
    A_3 = CHANGER CHAM A_3 MO1 'RIGIDITE'                       ;
*
    TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 YG3 Y_3' ;
    TEX2 = TEXT CHAYGI ' G12 G_1 G23 G_2 G13 G_3' ;
    TEX3 = TEXT CHAYGI ' NU12 N_1 NU23 N_2 NU13 N_3' ;
    TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ALP3 A_3' ;
   SINON ;

*>>3*************** orthotropie  222222222222222 DDDDDDDDDD

    TAB1.TETMAT.MO1.YG1  = @EVMAT TAB1.NOM_MAT.I1   'YG1' TAB1  ;
    TAB1.TETMAT.MO1.YG2  = @EVMAT TAB1.NOM_MAT.I1   'YG2'  TAB1 ;
    EVMA1 = EVMA1 ET TAB1.TETMAT.MO1.YG1 ET TAB1.TETMAT.MO1.YG2  ;

    TITRE NOM_MAT1 ' POISSON COEFFICIENT '             ;
    TAB1.TETMAT.MO1.NU12    = @EVMAT TAB1.NOM_MAT.I1   'NU12' TAB1  ;

    EVMA2 = EVMA2 ET TAB1.TETMAT.MO1.NU12     ;

    TITRE NOM_MAT1 ' THERMAL EXPANSION '             ;
    TAB1.TETMAT.MO1.ALP1    = @EVMAT TAB1.NOM_MAT.I1   'ALP1' TAB1  ;
    TAB1.TETMAT.MO1.ALP2    = @EVMAT TAB1.NOM_MAT.I1   'ALP2' TAB1  ;
    EVMA3 = EVMA3 ET TAB1.TETMAT.MO1.ALP1 ET TAB1.TETMAT.MO1.ALP2  ;
    TAB1.TETMAT.MO1.G12      = @EVMAT TAB1.NOM_MAT.I1   'G12'  TAB1 ;
    TM_1 =    ( REDU CHP_TM1 TAB1.ZONE_MAT.I1  )       ;
*
*** DIRECTION 1
*
    Y_1  = VARI  TM_1   TAB1.TETMAT.MO1.YG1  YG1 ;
    G_1  = VARI  TM_1   TAB1.TETMAT.MO1.G12  G12 ;
    N_1 = VARI  TM_1   TAB1.TETMAT.MO1.NU12  NU12   ;
    A_1 = VARI  TM_1   TAB1.TETMAT.MO1.ALP1  ALP1    ;
*
    N_1 = CHANGER CHAM N_1 MO1 'RIGIDITE'                      ;
    Y_1   = CHANGER CHAM Y_1   MO1 'RIGIDITE'                       ;
    G_1   = CHANGER CHAM G_1   MO1 'RIGIDITE'                       ;
    A_1  = CHANGER CHAM A_1  MO1 'RIGIDITE'                       ;
*
*** DIRECTION 2
*
    Y_2   = VARI  TM_1   TAB1.TETMAT.MO1.YG2   YG2 ;
    A_2  = VARI  TM_1   TAB1.TETMAT.MO1.ALP2  ALP2    ;
    Y_2   = CHANGER CHAM Y_2   MO1 'RIGIDITE'                       ;
    A_2  = CHANGER CHAM A_2  MO1 'RIGIDITE'                       ;

    TEX1 = TEXT CHAYGI ' YG1 Y_1 YG2 Y_2 ' ;
    TEX2 = TEXT CHAYGI ' G12 G_1 ' ;
    TEX3 = TEXT CHAYGI ' NU12 N_1 ' ;
    TEX4 = TEXT CHAYGI ' ALP1 A_1 ALP2 A_2 ' ;
   FINSI ;
**               MA1 =         MATR MO1 (TEXT CHAYG1   ' Y_1 ' ) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYG2   ' Y_2 ')) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYG3   ' Y_3 ')) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYG12  ' G_1' )) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYG23  ' G_2' )) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYG13  ' G_3' )) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYNU12 ' N_1' )) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYNU23 ' N_2' )) ;
**               MA1 = MA1 ET (MATR MO1 (TEXT CHAYNU13 ' N_3' )) ;
;
    MA1  = MATR  MO1 TEX1  (TEXT TAB1 . TEXTMECA . 101 )   ;
    MA2  = MATR  MO1 TEX2  (TEXT TAB1 . TEXTMECA . 101 ) ;
    MA3  = MATR  MO1 TEX3  (TEXT TAB1 . TEXTMECA . 101 )     ;
    MA4  = MATR  MO1 TEX4  (TEXT TAB1 . TEXTMECA . 101 )         ;
    MA1  = MA1 ET MA2 ET MA3 ET MA4                ;

*>>2 ************* Isotropie


  SINON                                           ;
   MESS '>>> NON ORTHO' TAB1.TEXTMECA.I1         ;
   TITRE NOM_MAT1 ' YOUNG MODULUS '              ;
   TAB1.TETMAT.MO1.YOUN    = @EVMAT  TAB1.NOM_MAT.I1   'YOUN'  TAB1 ;
   EVMA1                   = EVMA1 ET TAB1.TETMAT.MO1.YOUN      ;
   TITRE NOM_MAT1 ' POISSON COEFFICIENT '             ;
   TAB1.TETMAT.MO1.NU      = @EVMAT TAB1.NOM_MAT.I1   'NU' TAB1;
   EVMA2                   = EVMA2 ET TAB1.TETMAT.MO1.NU        ;
   TITRE NOM_MAT1 ' THERMAL EXPANSION '             ;
   TAB1.TETMAT.MO1.ALPH     = @EVMAT TAB1.NOM_MAT.I1   'ALPH' TAB1;
   EVMA3                   = EVMA3 ET TAB1.TETMAT.MO1.ALPH       ;
   TM_1 =    ( REDU CHP_TM1 TAB1.ZONE_MAT.I1  )                  ;
   Y_1  = VARI  TM_1   TAB1.TETMAT.MO1.YOUN   YOUN               ;
   NU_1 = VARI  TM_1   TAB1.TETMAT.MO1.NU     NU                 ;
   AL_1 = VARI  TM_1   TAB1.TETMAT.MO1.ALPH   ALPH               ;
   NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE'                       ;
   Y_1  = CHANGER CHAM Y_1  MO1 'RIGIDITE'                       ;
   AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE'                       ;
   TEX1     = TEXTE  ' YOUN Y_1  NU  NU_1  ALPH AL_1 '           ;
   MA1 =  MATR MO1 TEX1                                          ;
  FINSI                                                           ;
*>>2
  IMOTM1               = DIME (MOTS  TMECA_I1)                  ;
  SI ( IMOTM1   EGA 5  )                                        ;
   TITRE NOM_MAT1 ' YIELD STRESS '                            ;
   TAB1.TETMAT.MO1.SIGY    = @EVMAT TAB1.NOM_MAT.I1 'SIGY'  TAB1 ;
   EVMA4                   =  EVMA4 ET  TAB1.TETMAT.MO1.SIGY    ;
   TEX1  =  TEXTE TEX1  ' SIGY YM_1 '                           ;
   TITRE NOM_MAT1 ' YIELD MODULUS'             ;
   YM_1  =  VARI  TM_1   TAB1.TETMAT.MO1.SIGY     SIGY         ;
   YM_1  =  CHANGER CHAM YM_1  MO1 'RIGIDITE'                  ;
   TAB1.TETMAT.MO1.H       = @EVMAT TAB1.NOM_MAT.I1 'H' TAB1 ;
   EVMA5                   =  EVMA5 ET  TAB1.TETMAT.MO1.H          ;
   H_1 =  VARI  TM_1  TAB1.TETMAT.MO1.H    H                       ;
   H_1 =  CHANGER CHAM H_1 MO1 'RIGIDITE'                          ;
   TEX1     = TEXTE TEX1  'H H_1 '                                 ;
   MA1 =  MATR MO1 TEX1 ;
*                                            TEMP IMPR PLACE      ;
*                                            MENAGE               ;

    @TRCPLAS TAB1 MO1 I1                                             ;
    TEX5 = TEXT ' MA1  = MATR  MO1 '                                 ;
*                                          TEX5 TEX1  TEX2 TEX3 TEX4 ;
    FINSI;
*>1
  SINON                                                               ;
    QUITTER BOMA11                                                    ;
  FINSI                                                               ;
*>1
  SI ( I1 EGA 1 )                                                     ;
   MOD_1 = MO1                                                        ;
   MAT_1 = MA1                                                        ;
  SINON                                                               ;
   MOD_1 = MOD_1 ET MO1                                        ;
   MAT_1 = MAT_1 ET MA1                                        ;
  FINSI                                                 ;
  TAB1.MAT_MAT.I1 =   MA1                                        ;
 FIN BOMA11                                            ;
 TAB1.MATTOT = MAT_1                               ;
 TAB1.MODTOT = MOD_1                               ;
 TAC8 = TABLE                           ;
 TAC8.1 = ' NOLI '         ;
 TAC8.2 = 'MARQ PLUS REGU'         ;
 TAC8.3 = 'MARQ ETOI REGU'         ;
 TAC8.4 = 'MARQ LOSA REGU'         ;
 TAC8.5 = 'MARQ CARR REGU'                     ;
 TAC8.6 = 'MARQ TRIA REGU'                     ;
 TAC8.7 = 'MARQ TRIB REGU'                     ;
 TAC8.8 = 'MARQ PLUS REGU'         ;
 TAC8.9 = 'MARQ ETOI REGU'         ;
 TAC8.10 = 'MARQ CROI REGU'         ;
 DESS EVMA1 XBOR 0. 2000. LEGE    MIMA DATE TAC8 ;
 DESS EVMA2 XBOR 0. 2000. LEGE    MIMA DATE TAC8 ;
 DESS EVMA3 XBOR 0. 2000. LEGE    MIMA DATE TAC8 ;
 DESS EVMA4 XBOR 0. 2000. LEGE    MIMA DATE TAC8 ;
 DESS EVMA5 XBOR 0. 2000. LEGE    MIMA DATE TAC8 ;
MESS ' >>>>>>> fin materiaux'                     ;
MO1 = TAB1.MODL_MAT.1                            ;
MA1 = TAB1.MAT_MAT.1                            ;
CHAEPXX = MANU 'CHML'  MO1 EPXX 0.001 EPYY 0. EPZZ 0.
                           GAXY 0.    GAXZ 0. GAYZ 0.
 TYPE 'DEFORMATIONS' 'STRESSES' ;
HO11 = HOOK MO1 MA1                              ;
CHASIXX = MO1 HO11 * CHAEPXX                         ;
MESS ' >>>****** MAXI MINI CONT ' (MAXI CHASIXX AVEC (MOTS SMXX))
                                  (MINI CHASIXX AVEC (MOTS SMXX));
CHAEEXX = MO1 HO11 * CHASIXX                         ;
MESS ' >>>****** MAXI MINI CONT ' (MAXI CHAEEXX AVEC (MOTS EPXX))
                                  (MINI CHAEEXX AVEC (MOTS EPXX));
MESS '---------------------------------> sortie  de  DEFMAT';
FINPROC ;
*                                                                       *
*                                                                       *
*                                                                       *
*                                                                       *
DEBPROC DEFORAPH    LIGN_1*MAILLAGE
                  INSTEVOL*FLOTTANT
                      MOD1*MMODEL
                      TAB1*TABLE
                       SM1/EVOLUTION
                       EM1/EVOLUTION
                      VAL1/FLOTTANT
                      VAL2/FLOTTANT;

MESS '-----------------------------------> entree dans DEFORAPH '    ;
*
*  !!! NON ENCORE OPERATIONNEL !!!
*
MESS ' !!! NON ENCORE OPERATIONNEL !!! '    ;

DIM1 = VALEUR DIME ;

* test sur la dimension
SI (EGA DIM1 2);
 MESS ' attention contraph ne tourne pas en 3D';
 QUITTER CONTRAPH ;
* malgre le probleme de PROI en 3D, qui n a pas ete regle
* mais qu on accepte faute de mieux
FINSI;


SI (NON (EXISTE TAB1 RESUCONT))                                      ;
 MESS ' TAB1 NE CONTIENT PAS DE CONTRAINTES '                        ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

* test sur la dimension de LIGN_1*MAILLAGE : a faire

LCONFON = FAUX                                                       ;
MAIL_1 =  MOD1  EXTR 'MAIL'                                          ;
N_1 = NBNO  MAIL_1                                                   ;
N_2 = NBNO (MAIL_1 ET LIGN_1  )                                      ;

SI ( EGA N_1 N_2 )                                                   ;
 LCONFON = VRAI                                                      ;
FINSI                                                                ;

SI (NON(EXISTE TAB1 TETMAT))                                         ;
 MESS ' TAB1 NE CONTIENT PAS DE TETMAT '                             ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

SI (NON(EXISTE (TAB1.TETMAT) MOD1))                                  ;
 MESS ' TAB1.TETMAT NE CONTIENT PAS DE MODELE '                      ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

SI (NON(EXISTE (TAB1.TETMAT.MOD1) SIGY))                             ;
 MESS ' LE MATERIAU DEMANDE N EST PAS PLASTIQUE '                    ;
 MESS ' SORTIE DE CONTRAPH '                                         ;
 QUITTER CONTRAPH                                                    ;
FINSI                                                                ;

TITR ' DEPOUILLEMENT LE LONG DE LA LIGNE ' ;
*
* --- Depouillement en deformation
*
DEPL1   = TAB1.RESUDEPL.INSTEVOL                                    ;
TOTA1 = EPSI MOD1 (REDU DEPL1 (EXTR MOD1 MAIL))                  ;
PLAS1 = EXCO  ( TAB1.RESUVARI. INSTEVOL) EPSE              ;

* --- METHODE 1
* evaluation de la deformation ELASTIQUE PAR ELAS
* caract pris contant egal a sa moyenne sur l'intervalle de T considere
* deduction de EPStherm
CONT1 = REDU (TAB1.RESUCONT.INSTEVOL) MOD1 ;
ELAS1_1 = ELAS MOD1 CONT1 (TAB1.MAT_MAT.3) ;



* --- METHODE 2
* evaluation de la deformation du a la thermique
* alpha pris contant egal a sa moyenne sur l'intervalle de T considere
* deduction de EPS elas
ID1 = INDE (TAB1.'CHPOTHETA')                                        ;
CHT1 = TAB1.CHPOTHETA . INSTEVOL - (TAB1.CHPOTHETA. (ID1 . 1))       ;
CHT2 = (TAB1.CHPOTHETA. (ID1 . 1)) + (CHT1 / 2.)                     ;
ALPHA1 = VARI CHT2 TAB1.TETMAT.MOD1.'ALPH'                   ;
THER2_1 = ALPHA1  * (EXCO CHT1 'T')             ;
THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) * -1. ;
THER2_2 = (CHAN CHAM THER2_1 (EXTR MOD1 MAIL) NOEUD) ;



* evaluation de la limite elastique exprimee en epsilon
* cette limite est egale a Re/E c'est a dire SIGY / YOUN en langage CASTEM
* le tout dependant de la temperature du point considere

CHYOUN1  = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'YOUN'      ;
CHSIGY1  = VARI TAB1.CHPOTHETA.INSTEVOL TAB1.TETMAT.MOD1.'SIGY'      ;

CHYOUN2  = CHYOUN1 ** (-1) ;
CHSIGY2  = CHAN CHAM CHSIGY1 (EXTR MOD1 MAIL) NOEUD  ;

CHYOUN3  = CHAN CHAM CHYOUN2 (EXTR MOD1 MAIL) NOEUD ;
CHSIGY3  = CHSIGY2 ;

LIMELAS1 = CHSIGY3 * CHYOUN3                                         ;


SI  LCONFON                                                          ;
 TOTA2 = CHAN 'CHPO' MOD1 TOTA1                                ;
 PLAS2 = CHAN 'CHPO' MOD1 (REDU PLAS1  MOD1)                     ;
 LIMELAS2 = CHAN 'CHPO' MOD1 LIMELAS1                                ;
 THER2_3 = CHAN 'CHPO' MOD1 THER2_2;
 ELAS1_2 = CHAN 'CHPO' MOD1 ELAS1_1 ;
 SI (EXISTE EM1 )                                                    ;
 FINSI                                                               ;
SINON                                                                ;
 TOTA2 = PROI LIGN_1 (CHAN NOEUD MOD1 TOTA1)                   ;
 PLAS2 = PROI LIGN_1 (CHAN NOEUD MOD1 (REDU PLAS1 MOD1))       ;
 LIMELAS2 = PROI LIGN_1 LIMELAS1                                ;
 ELAS1_2 = PROI LIGN_1 (CHAN NOEUD MOD1 ELAS1_1) ;
 THER2_3 = PROI LIGN_1 THER2_2;
 SI (EXISTE EM1)                                                     ;
 FINSI                                                               ;
FINSI                                                                ;



SI (EGA DIM1 2) ;
 EXX1 = EXCO EPSETOT2 EPXX ;
 EYY1 = EXCO EPSETOT2 EPYY ;
 GXY1 = EXCO EPSETOT2 GAXY ;
 EPSETOT2 = ((2. ** .5 ) / 3.) *
       ((      ((EXX1 - EYY1 ) ** 2)
           + 6 * ((GXY1 * 2.   ) ** 2)
                ) ** .5);



SINON ;
 EXX1 = EXCO TOTA2 EPXX ;
 EYY1 = EXCO TOTA2 EPYY ;
 EZZ1 = EXCO TOTA2 EPZZ ;
 GXY1 = EXCO TOTA2 GAXY ;
 GXZ1 = EXCO TOTA2 GAXZ ;
 GYZ1 = EXCO TOTA2 GAYZ ;
 TOTA3 = ((2. ** .5 ) / 3.) * (
 ( ((EXX1 - EYY1 ) ** 2) + ((EXX1 - EZZ1 ) ** 2) +
   ((EYY1 - EZZ1 ) ** 2) + 6. * ( ((GXY1 / 2.) ** 2) +
 ((GXZ1 / 2.) ** 2) +   ((GYZ1 / 2.)** 2) ) )  ** .5);
 EXX1 = EXCO ELAS1_2 EPXX ;
 EYY1 = EXCO ELAS1_2 EPYY ;
 EZZ1 = EXCO ELAS1_2 EPZZ ;
 GXY1 = EXCO ELAS1_2 GAXY ;
 GXZ1 = EXCO ELAS1_2 GAXZ ;
 GYZ1 = EXCO ELAS1_2 GAYZ ;
 ELAS1_3 = ((2. ** .5 ) / 3.) * (
 ( ((EXX1 - EYY1 ) ** 2) + ((EXX1 - EZZ1 ) ** 2) +
   ((EYY1 - EZZ1 ) ** 2) + 6. * (( (GXY1 / 2.) ** 2) +
 ((GXZ1 / 2.)** 2) +   ((GYZ1 / 2.)** 2)) )  ** .5);


FINSI ;

THER1_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO ELAS1_3 SCAL) ;
ELAS2_1 = (EXCO TOTA3 SCAL) - (EXCO PLAS2 EPSE) - (EXCO THER2_3
 (EXTR (EXTR THER2_3 COMP) 1)) ;

EVEL1 = EVOL CHPO ELAS1_3 LIGN_1 ;
EVEL2 = EVOL CHPO ELAS2_1 LIGN_1 ;
TAC1 = TABLE ;
TAC1.1 = 'MARQ LOSA REGU TITR METH1';
TAC1.3 = 'MARQ CROI REGU TITR METH2';
EVELL = EVEL1 ET EVEL2 ;
DESS EVELL LEGE TAC1 ;

EVET1 = EVOL CHPO THER1_1 LIGN_1 ;
EVET2 = EVOL CHPO THER2_3 LIGN_1 ;
TAC1  =   TABLE ;
TAC1.1 = 'MARQ LOSA REGU TITR METH1';
TAC1.3 = 'MARQ CROI REGU TITR METH2';
EVETT  = EVET1 ET EVET2 ;
DESS EVETT LEGE TAC1 ;



TITRE 'EPS_TOT'                          ;
EVTOT1  = EVOL CHPO EPSETOT2 LIGN_1      ;
TITRE 'EPS_PLAS'                         ;
EVPLAS1 = EVOL CHPO EPSPLAS2 LIGN_1      ;
TITRE 'EPS_THER'                          ;
EVTHER1 = EVOL CHPO EPSTHER3 LIGN_1      ;
TITRE 'LIM_ELAS'                          ;
EVLIEL1 = EVOL CHPO LIMELAS2 LIGN_1      ;

TAD1 = TABLE                                                      ;
TAD1.1 =  CHAI 'MARQ CROI REGU TITR EPS_TOT'             ;
TAD1.3 =  CHAI 'MARQ ETOI REGU TITR EPS_PLAS '                     ;
TAD1.5 =  CHAI 'MARQ LOSA REGU TITR EPS_THER '                    ;
TAD1.7 =  CHAI 'MARQ TRIA REGU TITR LIM_ELAS '                       ;
EVEPS1 = EVTOT1 ET EVPLAS1 ET EVTHER1 ET EVLIEL1                  ;
DESS EVEPS1 LEGE MIMA TAD1                                        ;


MESS '-----------------------------------> sortie  de  DEFORAPH ' ;

FINPROC ;

**** @DEFO_EQ
DEBPROC @DEFO_EQ EPSE1*MCHAML MOD1*MMODEL  ;
MESS '----------------------------> calling @DEFO_EQ';

 EX1 = EXCO EPSE1 EPXX NOID SCAL ;
 EY1 = EXCO EPSE1 EPYY NOID SCAL ;
 EZ1 = EXCO EPSE1 EPZZ NOID SCAL ;
 EG1 = EXCO EPSE1 GAXY NOID SCAL ;
 EG2 = EXCO EPSE1 GAXZ NOID SCAL ;
 EG3 = EXCO EPSE1 GAYZ NOID SCAL ;

 TERM1 = (EX1 - EY1 ) ** 2 ;
 TERM2 = (EY1 - EZ1 ) ** 2 ;
 TERM3 = (EZ1 - EX1 ) ** 2 ;
 TERM4 = 6. *( ((ABS (EG1/2.) ) ** 2.)
          +    ((ABS (EG2/2.) ) ** 2.)
          +    ((ABS (EG3/2.) ) ** 2.)      );

 EPS_ETOI = ((2. ** .5 )/3.) *
          ((TERM1 + TERM2  + TERM3  + TERM4 ) ** .5 );

* MIN1 = MINI EPS_ETOI  ;
* MAX1 = MAXI EPS_ETOI  ;

* RM 30/08/95 suppression du trace du champ
*
* SI (EGA  MIN1 MAX1 1.E-6) ;
*  MESS ' epsilon equivalent constant egal a  ' MAX1;
* SINON ;
*  TITR1 = CHAIN 'mini maxi epsilon equivalent : 'MIN1 MAX1;
*  TITR TITR1 ;
*  TRAC EPS_ETOI MOD1 (EXTR MOD1 'MAIL');
* FINSI ;
*
MESS '----------------------------> exiting @DEFO_EQ';
FINPROC EPS_ETOI;
**** @DEMATH1
DEBPROC @DEMATH1 TAB1*TABLE          ;

MESS ' ';
NIVEAU = TAB1.'NIVEAU' ;
V1     = VALE DIME ;

* modification RMITTEAU le 6 juin 96 pour avoir les bonnes legendes
*dans les traces
* avec la version 96

SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> calling @DEMATH1';
FINSI ;

TACC1 = TABLE                           ;
TACC1.TITRE = TABLE ;
TAB1.DEF_MO = TABLE;
IC1 = 0                                 ;

SI ( EXISTE (TAB1.ZONE_MAT) 1 )                    ;
  MESS '>@DEMATH1> Materiau ----> 1 ';
  MESS '>@DEMATH1> Definition of the conductivity of '
  TAB1.NOM_MAT.1 ;
  TITRE 'MATERIAL CONDUCTIVITY OR CAPACITY'             ;
  TAB1.'MAILLAG1'     =   TAB1. ZONE_MAT.1             ;
  TAB1.'MAILLAGE'     =   TAB1. ZONE_MAT.1             ;

  SI ( EXISTE (TAB1.NOM_MAT) 1.1 )                     ;

   MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est orthotrope';
   SI ( NON ( EXISTE (TAB1.NOM_MAT) 1) )                      ;
    TAB1.  NOM_MAT . 1  = TEXT   '_ORTHOTROPE'                     ;
   FINSI                                              ;

   TAB1.'EVOKX1'     = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE' TAB1 ;
   TAB1.'EVOKY1'     = @EVMAT (TAB1.NOM_MAT. 1.2) 'CONDUCTIVITE' TAB1 ;
   TAB1.'EVOKZ1'     = @EVMAT (TAB1.NOM_MAT. 1.3) 'CONDUCTIVITE' TAB1 ;

   TAB1.'CONDUCT1'   = @EVMAT (TAB1.NOM_MAT. 1.1) 'CONDUCTIVITE'
                                                              TIN TAB1;
   si (ega v1 2) ;
    EVMA1             =  ( TAB1.'EVOKX1') ET  ( TAB1.'EVOKY1')     ;
    IC1 = IC1 + 1;
    TACC1.IC1 = 'MARQ CARR '         ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
    IC1 = IC1 + 1                                 ;
    TACC1.IC1 = 'MARQ TRIA '         ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
   sinon ;
    EVMA1   =  ( TAB1.'EVOKX1') ET  ( TAB1.'EVOKY1') ET TAB1.'EVOKZ1' ;
    IC1 = IC1 + 1;
    TACC1.IC1 = 'MARQ CARR '         ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.1 ;
    IC1 = IC1 + 1                                 ;
    TACC1.IC1 = 'MARQ TRIA '         ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.2 ;
    IC1 = IC1 + 1                                 ;
    TACC1.IC1 = 'MARQ TRIA '         ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1.3 ;

   finsi ;
   TAB1.DEF_MO.1 = MODL TAB1.ZONE_MAT.1 'THERMIQUE' 'ORTHOTROPE' ;

  SINON                                                 ;
   MESS '>@DEMATH1> ' TAB1.NOM_MAT.1 ' est isotrope';
   TAB1.'EVOCON1'   = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1;
   TAB1.'CONDUCT1'  = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TIN TAB1;
   TAB1.'EVOCOND'   = @EVMAT (TAB1.NOM_MAT.1) 'CONDUCTIVITE' TAB1 ;
   EVMA1            =   TAB1.'EVOCON1'             ;
   TAB1.DEF_MO.1 = MODL TAB1.ZONE_MAT.1 'THERMIQUE' 'ISOTROPE' ;
   IC1 = IC1 + 1                                 ;
   TACC1.IC1 = 'MARQ TRIA  ' ;
    TACC1.TITRE.IC1 = TAB1.NOM_MAT.1;
   MESS TACC1.IC1 ;
  FINSI                                              ;
  SI ( TAB1.TRANSITOIRE )                            ;
   MESS '>@DEMATH1> Definition of the capacity     of '
   TAB1.NOM_MAT.1 ;
   TAB1.'EVOCAPA'      =  @EVMAT (TAB1.  NOM_MAT.1) 'CAPACITE' TAB1;
   EVCA1               =  TAB1.'EVOCAPA'             ;
  FINSI                                                ;
FINSI                                                ;
SI ( EXISTE (TAB1.ZONE_MAT) 2 )                    ;
  MESS '>@DEMATH1> Materiau ----> 2 ';
  MESS '>@DEMATH1> Definition of the conductivity of '
  TAB1.NOM_MAT.2 ;
  TAB1.'MAILLAG2'     =   TAB1. ZONE_MAT.2             ;
*  TAB1.'EVOCON2'  = @EVMAT (TAB1.  NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
*  TAB1.'CONDUCT2' = @EVMAT (TAB1.  NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1 ;
*  EVMA1               = EVMA1 ET ( TAB1.'EVOCON2')          ;
*   IC1 = IC1 + 1                                 ;
*   TACC1.IC1 = ET 'MARQ CARR TITRE ' TAB1.NOM_MAT.2;
*   TAB1.DEF_MO.2 = MODL TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
*> js 050296
  SI ( EXISTE (TAB1.NOM_MAT) 2.1 )                     ;
   MESS '>@DEMATH1> ' TAB1.NOM_MAT.2 ' est orthotrope';
   SI ( NON ( EXISTE (TAB1.NOM_MAT) 2) )                      ;
    TAB1.  NOM_MAT . 2  = TEXT   '_ORTHOTROPE'                     ;
   FINSI                                              ;
   TAB1.'EVOKX2'     = @EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TAB1 ;
   TAB1.'EVOKY2'     = @EVMAT (TAB1.NOM_MAT. 2.2) 'CONDUCTIVITE' TAB1 ;
   TAB1.'EVOKZ2'     = @EVMAT (TAB1.NOM_MAT. 2.3) 'CONDUCTIVITE' TAB1 ;
   TAB1.'CONDUCT2' =@EVMAT (TAB1.NOM_MAT. 2.1) 'CONDUCTIVITE' TIN TAB1;
   EVMA1              = EVMA1 ET ( TAB1.'EVOKX2') ET  ( TAB1.'EVOKY2');
   IC1 = IC1 + 1;
   TACC1.IC1 = 'MARQ CROI '         ;
   TACC1.TITRE.IC1 =  (TAB1.NOM_MAT.2.1);
*   MESS TACC1.IC1 ;
   IC1 = IC1 + 1                                 ;
   TACC1.IC1 = 'MARQ TRIA '         ;
   TACC1.TITRE.IC1 =  (TAB1.NOM_MAT.2.2);
*   MESS TACC1.IC1 ;
   TAB1.DEF_MO.2 = MODL TAB1.ZONE_MAT.2 'THERMIQUE' 'ORTHOTROPE' ;
  SINON                                                 ;
   TAB1.'EVOCON2'   = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1;
   TAB1.'CONDUCT2'  = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TIN TAB1;
   TAB1.'EVOCON2'   = @EVMAT (TAB1.NOM_MAT.2) 'CONDUCTIVITE' TAB1 ;
   EVMA1            = EVMA1 ET  TAB1.'EVOCON2'             ;
   TAB1.DEF_MO.2 = MODL TAB1.ZONE_MAT.2 'THERMIQUE' 'ISOTROPE' ;
   IC1 = IC1 + 1                                 ;
   TACC1.IC1 =  'MARQ TRIB ' ;
   TACC1.TITRE.IC1 =  (TAB1.NOM_MAT.2);
*   MESS TACC1.IC1 ;
  FINSI                                              ;
*>
  SI ( TAB1.TRANSITOIRE )                            ;
   MESS '>@DEMATH1> Definition of the capacity     of '
 TAB1.NOM_MAT.2 ;
   TAB1.'EVOCAP2'      =   @EVMAT (TAB1.  NOM_MAT.2) 'CAPACITE' TAB1 ;
   EVCA1               = EVCA1 ET ( TAB1.'EVOCAP2')          ;
  FINSI                                                ;
FINSI                                                ;
SI ( EXISTE (TAB1.ZONE_MAT) 3 )                    ;
  MESS '>@DEMATH1> Materiau ----> 3 ';
  MESS '>@DEMATH1> Definition of the conductivity of '
  TAB1.NOM_MAT.3 ;
  TAB1.'MAILLAG3'     =   TAB1. ZONE_MAT.3             ;
  TAB1.'EVOCON3'  = @EVMAT (TAB1.  NOM_MAT.3) 'CONDUCTIVITE' TAB1 ;
  TAB1.'CONDUCT3' = @EVMAT (TAB1.  NOM_MAT.3) 'CONDUCTIVITE' TIN TAB1 ;
  EVMA1               = EVMA1 ET ( TAB1.'EVOCON3')          ;
   IC1 = IC1 + 1                                 ;
   TACC1.IC1 =  'MARQ ETOI  ' ;
   TACC1.TITRE.IC1=TAB1.NOM_MAT.3;
   TAB1.DEF_MO.3 = MODL TAB1.ZONE_MAT.3 'THERMIQUE' 'ISOTROPE' ;
  SI ( TAB1.TRANSITOIRE )                            ;
   MESS '>@DEMATH1> Definition of the capacity     of '
 TAB1.NOM_MAT.3 ;
   TAB1.'EVOCAP3'      =   @EVMAT (TAB1.  NOM_MAT.3) 'CAPACITE' TAB1  ;
   EVCA1               = EVCA1 ET ( TAB1.'EVOCAP3')          ;
  FINSI                                                ;
FINSI                                                ;
SI ( EXISTE (TAB1.ZONE_MAT) 4 )                    ;
  MESS '>@DEMATH1> Material ----> 4 ';
  MESS '>@DEMATH1> Definition of the conductivity of '
  TAB1.NOM_MAT.4 ;
  TAB1.'MAILLAG4'     =   TAB1. ZONE_MAT.4             ;
  TAB1.'EVOCON4'  = @EVMAT (TAB1.  NOM_MAT.4) 'CONDUCTIVITE' TAB1 ;
  TAB1.'CONDUCT4' = @EVMAT (TAB1.  NOM_MAT.4) 'CONDUCTIVITE' TIN TAB1 ;
  EVMA1               = EVMA1 ET ( TAB1.'EVOCON4')          ;
   IC1 = IC1 + 1                                 ;
   TACC1.IC1 =  'MARQ LOSA  ' ;
   TACC1.TITRE.IC1 = TAB1.NOM_MAT.4 ;
   TAB1.DEF_MO.4 = MODL TAB1.ZONE_MAT.4 'THERMIQUE' 'ISOTROPE' ;
  SI ( TAB1.TRANSITOIRE )                            ;
   MESS '>@DEMATH1> Definition of the capacity     of ' TAB1.NOM_MAT.4 ;
   TAB1.'EVOCAP4'      = @EVMAT (TAB1.  NOM_MAT.4) 'CAPACITE' TAB1 ;
   EVCA1               = EVCA1 ET ( TAB1.'EVOCAP4')          ;
  FINSI                                                ;
FINSI                                                ;
SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> exiting  @DEMATH1';
FINSI ;
FINPROC  EVMA1 EVCA1 TACC1                                ;


**** @DEMATH2
DEBPROC @DEMATH2 TAB1*TABLE          ;
 TAB1.TABCON = TABLE                      ;
 IPP1 = 0                                ;
  REPETER BOUCM7                              ;
    IPP1 = IPP1 + 1                                   ;
    SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                         ;
*    MO_1  = MODL TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE';
     MO_1  = TAB1.DEF_MO.IPP1    ;
     TAB1.ZONE_MAT.IPP1 = EXTR 'MAIL' TAB1.DEF_MO.IPP1    ;
     TAB1.TABCON.MO_1 =@EVMAT (TAB1.NOM_MAT.IPP1) 'CONDUCTIVITE' TAB1;
    SINON                                                      ;
     QUITTER BOUCM7                                           ;
    FINSI                                                      ;
  FIN BOUCM7                                                   ;
FINPROC  EVMA1 EVCA1 TACC1                                ;


DEBPROC DEPOMIMA TAB1*TABLE ;
OPTION ECHO 1 IMPR 99  TRAC BENS  ;
MOD_1 = TAB1.MODTOT ;
MAT_1 = TAB1.MATTOT                              ;
SI (EXISTE TAB1 L_ADEPOU )                        ;
   L_1   = TAB1.L_ADEPOU                            ;
FINSI ;
SI ( NON (EXISTE TAB1 MO_ADEPOU ))                        ;
 MOTOT1 = MOD_1 ;
SINON ;
 MOTOT1 = TAB1.MO_ADEPOU  ;
FINSI ;
N_MAIL = EXTR 'MAIL' MOTOT1                                ;
*SI ( NON (EXISTE TAB1 NMAIL_ADEPOU ))                        ;
* N_MAIL  = 'MAIL TOT' ;
*SINON ;
* N_MAIL = TAB1.NMAIL_ADEPOU  ;
*FINSI ;
I1 = 0                                                   ;
MESS  '        >>>>>>>> '   N_MAIL   ' :' ;
MESS  '     ====================================' ;
SAUT 2 LIGNE ;
MESS  '******************************' ;
MESS  '***     CONTRAINTES         **' ;
MESS  '******************************' ;
REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU )                  ;
  I1 = I1 + 1                                              ;
  XIT1 = EXTR I1 TAB1.L_CASADEPOU                           ;
  VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1                      ;
  SIRESU1 = TAB1.RESUCONT.XIT1  ET VMI1                    ;
  SIRESUA = TAB1.RESUVARI.XIT1  ET VMI1                    ;
  I2 = 0                                                   ;
  SAUT 2 LIGNE ;
  MESS 'TIME' XIT1   ;
  SAUT  LIGNE ;
  MESS '                  MINI         *    MAXI';
  SAUT  LIGNE ;
   REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP)                  ;
    I2 = I2 + 1                                              ;
    MOCOMP = EXTR TAB1.LM_SIGCOMP I2                        ;
    TMOCOMP = TEXT    MOCOMP         ;
    SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') )      ;
      MOCOMP = 'SCAL'                                       ;
    FINSI                                                   ;
    SBID1 = REDU ( EXCO  SIRESU1 MOCOMP ) MOTOT1 ;
    MAXSB1 = ((MAXI SBID1)/1.E6) ;
    MINSB1 = ((MINI SBID1)/1.E6) ;
    MESS  TMOCOMP  ' (MPa)  : ' MINSB1 ' * ' MAXSB1 ;
   FIN  BDEPO2                                              ;
   SI (EXISTE TAB1 L_ADEPOU )                        ;
      DEPOULI L_1 'CONTRAINTES' MOD_1 TAB1.RESUCONT.XIT1
                   GLOBAL MASSIF ;
   FINSI ;
  FIN BDEPO1                                                ;
  I3 = 0                                                   ;
  SAUT 2 LIGNE ;
  MESS  '******************************' ;
  MESS  '***     DEFORMATIONS       **' ;
  MESS  '******************************' ;
  SAUT 2 LIGNE ;
  REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU )                  ;
   I3 = I3 + 1                                              ;
   XIT1 = EXTR I3 TAB1.L_CASADEPOU                           ;
   DEPL_1 = TAB1.RESUDEPL.XIT1                              ;
   SI_1   = TAB1.RESUCONT.XIT1                              ;
   EPS_0   = EPSI MOD_1 DEPL_1                              ;
   EPS_1 = EPS_0 ET ( EXCO EPSE TAB1.RESUVARI.XIT1)         ;
   I4 = 0                                                   ;
   SAUT 2 LIGNE ;
   MESS 'TIME' XIT1   ;
   SAUT  LIGNE ;
   MESS '                  MINI         *    MAXI DU MCHAM PTS GAUSS';
   SAUT  LIGNE ;
   REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP)                  ;
    I4 = I4 + 1                                              ;
    MOCOMP = EXTR TAB1.LM_EPSCOMP I4                        ;
    TMOCOMP = TEXT    MOCOMP         ;
    SI (( EGA MOCOMP 'EPZZ' )  ET ( EGA (VALE MODE) 'PLANCONT'))  ;
      EPS_2  = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1
        (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1    )  ;
      EPSB2 =  REDU ( EXCO  EPS_2 MOCOMP ) MOTOT1  ;
      MAXEB2 = ((MAXI EPSB2) * 1.E2) ;
      MINEB2 = ((MINI EPSB2) * 1.E2) ;
      MESS  TMOCOMP  ' ( % )  : ' MINEB2 ' * ' MAXEB2 ;
    SINON                                                   ;
      EPSB1 = REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1 ;
      MAXEB1 = ((MAXI EPSB1) * 1.E2) ;
      MINEB1 = ((MINI EPSB1) * 1.E2) ;
      MESS  TMOCOMP  ' ( % )  : ' MINEB1 ' * ' MAXEB1 ;
    FINSI                                                   ;
   FIN  BDEPO4                                              ;
  SI (EXISTE TAB1 L_ADEPOU )                        ;
     DEPOULI L_1 'DEFORMATIONS' MOD_1  EPS_0 GLOBAL MASSIF ;
  FINSI ;
  FIN BDEPO3                                                ;
SAUT PAGE ;
OPTI ECHO 1 IMPR 6;
FINPROC ;
*****************************************************************
*                                                               *
* Procedure DEPOULI : trace des contraintes ou des deformations *
*                     le long d'un ligne quelconque             *
*                                                               *
*****************************************************************
'DEBPROC' FRENETT       LIGN_1*MAILLAGE      ;
MESS '----------------------> entree dans FRENETT ';
  V1 = VALEUR DIME             ;
  SI( V1 EGA 2 )               ;
   CHT CHN CHB  = FRENET  LIGN_1 'TRACE' ;
   CHPP = CHT ET CHN ;
  SINON ;
   CHT CHN CHB  = FRENET  LIGN_1 'TRACE' (0. 0. 1000.);
   CHPP = CHT ET CHN ET CHB     ;
  FINSI  ;
MESS '----------------------> sortie  de  FRENETT ';
'FINPROC'  CHPP;



'DEBPROC' DEPOULI       LIGN_1*MAILLAGE M_IND1*MOT
                        MOD_L*MMODEL MCHA_E2*MCHAML
                        M_REP2*MOT M_ELEM*MOT
                        VECT1/POINT VECT2/POINT
                        MCHA_E3/MCHAML ;

MESS '----------------------> entree dans DEPOULI';

TAB1 = TABLE;
TAC1 = TABLE ;

SI (( NON (EGA M_ELEM 'MASSIF')) ET
    (NON (EGA M_ELEM 'INFE')) ET
    (NON (EGA M_ELEM 'MOYE')) ET
    (NON (EGA M_ELEM 'SUPE')));
 MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_ELEM ;
 MESS '>>>DEPOULI>>>> ON STOPPE ICI ....'  ;
 ERREUR 'MAUVAIS_INDIC_ELEMENT_DANS_DEPOULI';
FINSI ;


SI (( NON (EGA M_REP2 'FIXE')) ET
    (NON (EGA M_REP2 'GLOBAL')) ET
    (NON (EGA M_REP2 'LOCAL')));
 MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_REP2 ;
 MESS '>>>DEPOULI>>>> ON STOPPE ICI ....'  ;
 ERREUR 'MAUVAIS_INDIC_REPERE_DANS_DEPOULI';
SINON;
 M_REPE = M_REP2 ;
FINSI ;


SI (( NON (EGA M_IND1 'CONTRAINTES')) ET
                         ( NON (EGA M_IND1 'DEFORMATIONS')) );
 MESS '>>>DEPOULI>>>> OPTION NON PREVU :' M_IND1 ;
 MESS '>>>DEPOULI>>>> ON STOPPE ICI ....'  ;
 ERREUR 'MAUVAIS_INDIC_DANS_DEPOULI';
FINSI ;

LCONFON = FAUX ;
MAIL_1 =  MOD_L  EXTR 'MAIL';
N_1 = NBNO  MAIL_1 ;
N_2 = NBNO (MAIL_1 ET LIGN_1  );

SI ( EGA N_1 N_2 ) ;
 LCONFON = VRAI;
FINSI ;

SI (EXISTE MCHA_E3);
 SI (EGA M_IND1 'CONTRAINTES');
  CAR1 = MCHA_E3;
 FINSI ;
 SI (EGA M_IND1 'DEFORMATIONS');
  MCHA_EP = MCHA_E3;
 FINSI ;
FINSI;


SI (EGA M_IND1 'CONTRAINTES');
 MO_TI1 = MOT  'STRESSES ALONG THE LINE ' ;
FINSI               ;
SI (EGA M_IND1 'DEFORMATIONS');
 MO_TI1 = MOT  'STRAINS ALONG THE LINE ' ;
FINSI               ;

SI (EGA M_REPE 'FIXE');
 MO_TI2 = MOT ' (REPERE FIXE DONNE)';
SINON;
 SI (EGA M_REPE 'GLOBAL');
  MO_TI2 = MOT ' (REPERE GLOBAL)';
 SINON;
  MO_TI2 = MOT ' (REPERE LOCAL DE FRENET)';
 FINSI;
FINSI;


SI(NON (EXISTE L_COQ2 ));
 L_COQ1 = FAUX ;
SINON ;
 L_COQ1 = L_COQ2 ;
FINSI;


SI (EGA M_REPE 'FIXE');
 SI ((VALEUR DIME) EGA 3);
  MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1 VECT2;
  MCHA_E1 = MCHA_E11;
 SINON;
TYP1 = TYPE MCHA_E2; MESS TYP1;
  MCHA_E11 = RTENS MCHA_E2 MOD_L VECT1;
  MCHA_E1 = MCHA_E11;
 FINSI;
SINON;
 MCHA_E1 = MCHA_E2;
FINSI;


***CHTT1 CHPOINT sur la ligne
***EV_OTT evolution globale

CHM1 =  REDU MCHA_E1  MOD_L ;
TC1 = EXTR CHM1 'COMP' ;
LIST1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;


SI ( (EGA M_REPE 'FIXE') OU (EGA M_REPE 'GLOBAL') );

 SI (EGA M_IND1 'CONTRAINTES');
  SI (EGA (VALEUR DIME) 2);
   LIST2 = MOTS SMXX SMYY SMZZ SMXY VMIS TRES TREI TREE ;
  SINON;
   LIST2 = MOTS SMXX SMYY SMZZ SMXY SMXZ SMYZ VMIS TRES TREI TREE;
  FINSI;
 SINON;
  SI (EGA (VALEUR DIME) 2);
   LIST2 = MOTS EPXX EPYY EPZZ GAXY PLAS;
  SINON;
   LIST2 = MOTS EPXX EPYY EPZZ GAXY GAXZ GAYZ PLAS;
  FINSI;
 FINSI;

 I1 = 1;
 REPETER BOUC1 (DIME TC1 );
  MOC1 = ( EXTR TC1 I1 );
  SSI1 =  EXCO MOC1 CHM1 'SCAL';
  SI  LCONFON;
   CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  SINON ;
   CHI1 =  PROI LIGN_1      ( CHAN NOEUD MOD_L SSI1 );
  FINSI;
  CHI1 = NOMC MOC1 CHI1;
  EV_I1   = EVOL CHPO CHI1 MOC1 LIGN_1;
  TAB1.MOC1 = EV_I1;
  TITRE  MO_TI1 MO_TI2;
  SI ( I1 EGA 1 );
   MARQ1 = TEXT (EXTR 1 LIST1);
   COMP1 = TEXT (EXTR 1 LIST2);
*   TAC1.1 = CHAINE ' MARQ ' MARQ1 ' REGU ' ' TITR ' COMP1;
   EV_OTT  = EV_I1;
   CHTT1  = CHI1;
  SINON ;
   DIM1 = DIME EV_OTT;
   MARQ1 = TEXT (EXTR I1 LIST1);
   COMP1 = TEXT (EXTR I1 LIST2);
*   TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU '  ' TITR ' COMP1;
   EV_OTT  =  EV_OTT ET  EV_I1 ;
   CHTT1  = CHTT1 ET CHI1;
  FINSI ;
  I1 = I1 + 1;
 FIN  BOUC1;
FINSI   ;

SI (EGA M_REPE  'LOCAL');
 SI (EGA M_IND1 'CONTRAINTES');
  SI (EGA (VALEUR DIME) 2);
   LIST2 = MOTS SMTT SMNN SMBB SMTN VMIS TRES TREI TREE;
  SINON;
   LIST2 = MOTS SMTT SMNN SMBB SMTN SMTB SMNB VMIS TRES TREI TREE;
  FINSI;
 SINON;
  SI (EGA (VALEUR DIME) 2);
   LIST2 = MOTS EPTT EPNN EPBB GATN PLAS;
  SINON;
   LIST2 = MOTS EPTT EPNN EPBB GATN GATB GANB PLAS;
  FINSI;
 FINSI;
 I1 = 1;

 REPETER BOUC3 (DIME TC1 );
  MOC1 = ( EXTR TC1 I1 );
  SSI1 =  EXCO MOC1 CHM1 'SCAL';
  SI  LCONFON;
   CHI1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L SSI1 );
  SINON ;
   CHI1 =  PROI LIGN_1      ( CHAN NOEUD MOD_L SSI1 );
  FINSI;
  CHI1 = NOMC MOC1 CHI1;
  TAB1.MOC1 = EV_I1;
  SI ( I1 EGA 1 );
   CHTT1  = CHI1;
  SINON ;
   CHTT1  = CHTT1 ET CHI1;
  FINSI ;
  I1 = I1 + 1;
 FIN  BOUC3;
 CHPP = FRENETT  LIGN_1                          ;
 CHTT2 = CHREP M_IND1 CHTT1 CHPP                 ;
 TC1 = EXTR CHTT2 'COMP'                         ;
 MENAGE                                          ;
 I1 = 1                                          ;
 REPETER BOUC2 (DIME TC1 )                       ;
  MOC1 = ( EXTR TC1 I1 )                         ;
  EV_I1   = EVOL CHPO CHTT2 MOC1 LIGN_1          ;
  TITRE   MO_TI1  MO_TI2                         ;
  MENAGE                                         ;
  SI ( I1 EGA 1 )                                ;
   MARQ1 = TEXT (EXTR 1 LIST1)                   ;
   COMP1 = TEXT (EXTR 1 LIST2)                   ;
*   TAC1.1 = CHAINE ' MARQ ' MARQ1  ' REGU TITR ' COMP1 ' ';
   EV_OTT  = EV_I1;
  SINON;
   DIM1 = DIME EV_OTT;
   MARQ1 = TEXT (EXTR I1 LIST1);
   COMP1 = TEXT (EXTR I1 LIST2);
*   TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1  ' REGU TITR ' COMP1 ' ';
   EV_OTT  =  EV_OTT ET  EV_I1;
  FINSI;
  I1 = I1 + 1;
  TAB1.MOC1 = EV_I1;
 FIN  BOUC2;
FINSI;

SI (EGA M_IND1 'CONTRAINTES');

 SI ((EGA M_ELEM 'MASSIF') OU (EGA M_ELEM 'MOYE'));

  DIM1 = DIME EV_OTT;
  MARQ1 = TEXT (EXTR I1 LIST1);
  COMP1 = TEXT (EXTR I1 LIST2);
*  TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  I1 = I1 + 1;

  SI (EXISTE MCHA_E3);
   VMI1 =  VMIS MOD_L CHM1 CAR1;
  SINON ;
   VMI1 = VMIS MOD_L CHM1 ;
  FINSI;
  SI  LCONFON;
   CHVM = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L VMI1 );
  SINON ;
   CHVM =  PROI LIGN_1      ( CHAN NOEUD MOD_L VMI1 );
  FINSI;
  EVVM   = EVOL ROUGE CHPO CHVM  SCAL LIGN_1;
  EV_OTT  = EV_OTT ET EVVM ;
  TAB1.VMIS = EVVM;

  DIM1 = DIME EV_OTT;
  MARQ1 = TEXT (EXTR I1 LIST1);
  COMP1 = TEXT (EXTR I1 LIST2);
*  TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
  I1 = I1 + 1;

  SI (EXISTE MCHA_E3);
   TRE1 = TRESCA MOD_L CHM1 CAR1 MOYE;
  SINON ;
   SI (EGA M_ELEM 'MASSIF');
     TRE1 = TRESCA MOD_L CHM1 ;
   SINON ;
     TRE1 = TRESCA MOD_L CHM1 MOYE;
   FINSI ;
  FINSI;
  SI  LCONFON;
   CHTR1 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE1 );
  SINON ;
   CHTR1 =  PROI LIGN_1      ( CHAN NOEUD MOD_L TRE1 );
  FINSI;
  EVTR1   = EVOL  VERT CHPO CHTR1  SCAL LIGN_1;
  EV_OTT  = EV_OTT ET EVTR1 ;
  TAB1.TRES1 = EVTR1;

 FINSI;


 SI (EGA M_ELEM 'MOYE') ;

  DIM1 = DIME EV_OTT;
  MARQ1 = TEXT (EXTR I1 LIST1);
  COMP1 = TEXT (EXTR I1 LIST2);
*  TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1  ' REGU TITR ' COMP1 ' ';
  I1 = I1 + 1;

  TRE2 = TRESCA MOD_L CHM1 CAR1 INFE;
  SI  LCONFON;
   CHTR2 = CHAN 'CHPO' MOD_L ( CHAN NOEUD MOD_L TRE2);
  SINON ;
   CHTR2 =  PROI LIGN_1      ( CHAN NOEUD MOD_L TRE2 );
  FINSI;
  EVTR2   = EVOL ROUGE CHPO CHTR2  SCAL LIGN_1;
  EV_OTT  = EV_OTT ET EVTR2 ;
  TAB1.TRES2 = EVTR2;


  DIM1 = DIME EV_OTT;
  MARQ1 = TEXT (EXTR I1 LIST1);
  COMP1 = TEXT (EXTR I1 LIST2);
*  TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU  TITR ' COMP1 ' ';

  TRE3 = TRESCA MOD_L CHM1 CAR1 SUPE;
  SI  LCONFON;
   CHTR3 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L TRE3 );
  SINON ;
   CHTR3 =  PROI LIGN_1 (CHAN NOEUD MOD_L TRE3 );
  FINSI;
  EVTR3 = EVOL ROSE CHPO CHTR3  SCAL LIGN_1;
  EV_OTT = EV_OTT ET EVTR3 ;
  TAB1.TRES = EVTR3;

 FINSI;
FINSI;

SI (EGA M_IND1  'DEFORMATIONS');
  SI ( EXISTE MCHA_E3 );
*   I2 = I1 * 2 - 1;
*   TAC1.I2 = 'MARQ ETOI TITR EPSE_PLAS';
   EPSE1 = EXCO EPSE (REDU MCHA_EP MOD_L) ;
   SI  LCONFON;
    EPSEL1 = CHAN 'CHPO' MOD_L (CHAN NOEUD MOD_L  EPSE1) ;
   SINON ;
    EPSEL1 = PROI LIGN_1 (CHAN NOEUD MOD_L  EPSE1) ;
   FINSI;
   EVOSE = EVOL  ROUGE CHPO EPSEL1 EPSE  LIGN_1 ;

   DIM1 = DIME EV_OTT;
   MARQ1 = TEXT (EXTR I1 LIST1);
   COMP1 = TEXT (EXTR I1 LIST2);
*   TAC1.(DIM1+1) = CHAINE ' MARQ ' MARQ1 ' REGU TITR ' COMP1 ' ';
   EV_OTT  = EV_OTT ET EVOSE ;
   TAB1.PLAS = EVOSE;
  FINSI;
FINSI;


DESS EV_OTT TAC1 MIMA LEGE ;

TAB1.MARC = TAC1;
TAB1.EVOL = EV_OTT;

MESS '----------------------> sortie  de  DEPOULI ';
FINPROC  TAB1;





















'DEBPROC' DEPT      LIGN_1*MAILLAGE MOD_L*MMODEL MCHA_E2*CHPOINT;

MESS '----------------------> entree dans DEPT';

LCONFON = FAUX ;
MAIL_1 =  MOD_L  EXTR 'MAIL';
N_1 = NBNO  MAIL_1 ;
N_2 = NBNO (MAIL_1 ET LIGN_1  );

SI ( EGA N_1 N_2 ) ;
 LCONFON = VRAI;
FINSI ;

MAIL1 = (extr MOD_L 'MAIL' ) ;
LEV1 = REDU MCHA_E2 MAIL1;

SI LCONFON ;
 LEV2 = REDU LEV1 LIGN_1 ;
 LEV3 = EVOL CHPO  LEV2 LIGN_1 ;
SINON ;
 LEV2 = PROI (CHAN CHAM LEV1 MAIL1 NOEUD ) LIGN_1 ;
 LEV3 = EVOL CHPO  LEV2 LIGN_1 ;
FINSI ;

DESS LEV3 ;




MESS '----------------------> sortie  de  DEPT ';
FINPROC  ;





















**** @DESCEND

DEBPROC @DESCEND CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
                 PASB0*FLOTTANT CHSIGN0*CHPOINT TAB1*TABLE ;
*
*****************************************************
* Procedure de descente des lignes de champ par une *
* methode explicite.    Alain MOAL (Fevrier 2001)   *
*****************************************************
*
*MESS '---------------------------------> calling @descend';
*
*--------------- VARIABLES D'ENTREE :
MAIL0 = TAB1.<MAILLAGE_B ;
*-----------------------------------
*
*---- Calcul du champ et de sa norme
BR BZ BPHI = @MAGNB TAB1 ;
*
*---- Descente dans le plan (R,Z)
BPHI = BPHI * 0. ;
PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
*AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
BX = BR * (COS PHI) - (BPHI * (SIN PHI));
BY = BR * (SIN PHI) + (BPHI * (COS PHI));
NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
*
*---- Deplacements (methode explicite) affectes du signe
*---- donnant le sens de descente dans le plan (R,Z)
DEPX0 = CHSIGN0 * BX * PASB0 / NORM_B ;
DEPY0 = CHSIGN0 * BY * PASB0 / NORM_B ;
DEPZ0 = CHSIGN0 * BZ * PASB0 / NORM_B ;
*
*---- Nouvelles coordonnees
X_NEW = CHP_X + DEPX0 ;
Y_NEW = CHP_Y + DEPY0 ;
Z_NEW = CHP_Z + DEPZ0 ;
*
*---- actualisation de la position des points de la ligne
DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
DEP0  = DEPX0 ET DEPY0 ET DEPZ0 ;
*
*MESS '---------------------------------> exiting @descend';
FINPROC X_NEW Y_NEW Z_NEW DEP0 ;

**** @DEXPJET

DEBPROC @DEXPJET CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
                PASB0*FLOTTANT TAB1*TABLE;

*MESS '---------------------------------> calling @DEXPJET';
*
*--------------- VARIABLES D'ENTREE :
MAIL0 = TAB1.<MAILLAGE_B ;
*-----------------------------------
*
*---- Calcul du champ et de sa norme
BR BZ BPHI = @MAGNB TAB1 ;
*
PHI = ATG (COOR 2 MAIL0) (COOR 1 MAIL0) ;
*AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
BX = BR * (COS PHI) - (BPHI * (SIN PHI));
BY = BR * (SIN PHI) + (BPHI * (COS PHI));
NORM_B = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
*
*---- Deplacements (methode explicite)
DEPX0 = BX * PASB0 / NORM_B ;
DEPY0 = BY * PASB0 / NORM_B ;
DEPZ0 = BZ * PASB0 / NORM_B ;

*MESS '---------------------------------> exiting @DEXPJET';
FINPROC DEPX0 DEPY0 DEPZ0 ;

**** @DEXPLI

DEBPROC @DEXPLI CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
                PASB0*FLOTTANT TAB1*TABLE;

*MESS '---------------------------------> calling @DEXPLI';

*--------------- VARIABLES D'ENTREE :
TYPCAL  = TAB1.<TYPE_CALCUL ;
*------------------------------------
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;

*        ---- Calcul du champ dans le repere global
         BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y
                                 CHP_Z ISHIFT IRIPPLE ;

*        ---- Calcul de la norme du champ

         NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;

*        ---- Calcul des deplacements

         DEPX0 = BXG * PASB0 / NORM_B ;
         DEPY0 = BYG * PASB0 / NORM_B ;
         DEPZ0 = BZG * PASB0 / NORM_B ;

*MESS '---------------------------------> exiting @DEXPLI';
FINPROC DEPX0 DEPY0 DEPZ0 ;
**** @DMILIEU

DEBPROC @DMILIEU CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
                 PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;

*MESS '---------------------------------> calling @DMILIEU';

*--------------- VARIABLES D'ENTREE :
TYPCAL  = TAB1.<TYPE_CALCUL ;
RP      = TAB1.<RP ;
HP      = TAB1.<HP ;
*------------------------------------
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;
*
SI (EGA (TYPE CHSIGN) MOT) ;
* --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
   CHSIGN = 1. ;
FINSI ;
*BR01/10/98 SI (EXISTE TAB1 <CHSIGN) ;
*   CHSIGN = TAB1.<CHSIGN ;
* --- Cas ou l'appel vient d'une proc qui n'a pas calcule TAB1.<CHSIGN
*SINON ;
*   CHSIGN = 1. ;
*FINSI ;

* ---- Lors du premier pas, calcul des points milieux
SI (NON (EXIS TAB1 <CHP_X1)) ;


         DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X CHP_Y CHP_Z PASB0 TAB1;
         CHP_X1 = CHP_X + (CHSIGN * DEPX0) ;
         CHP_Y1 = CHP_Y + (CHSIGN * DEPY0) ;
         CHP_Z1 = CHP_Z + (CHSIGN * DEPZ0) ;
SINON ;
         CHP_X1 = TAB1.<CHP_X1 ;
         CHP_Y1 = TAB1.<CHP_Y1 ;
         CHP_Z1 = TAB1.<CHP_Z1 ;
         MAILR = EXTR CHP_X MAIL ;
         CHP_X1 = REDU CHP_X1 MAILR ;
         CHP_Y1 = REDU CHP_Y1 MAILR ;
         CHP_Z1 = REDU CHP_Z1 MAILR ;
FINSI ;

* ---- Calcul du deplacement dans le repere global
* ---- (aux points milieux)

DEPX0 DEPY0 DEPZ0 = @DEXPLI CHP_X1 CHP_Y1 CHP_Z1 PASB0 TAB1 ;

* ---- Actualisation des points initiaux

X_NEW = CHP_X + (CHSIGN * DEPX0) ;
Y_NEW = CHP_Y + (CHSIGN * DEPY0) ;
Z_NEW = CHP_Z + (CHSIGN * DEPZ0) ;


* ---- Calcul du deplacement aux points initiaux remontes


DEPXI DEPYI DEPZI = @DEXPLI X_NEW Y_NEW Z_NEW PASB0 TAB1;

* ---- Calcul des nouveaux points milieux

CHP_X1 = CHP_X1 + (CHSIGN * DEPXI) ;
CHP_Y1 = CHP_Y1 + (CHSIGN * DEPYI) ;
CHP_Z1 = CHP_Z1 + (CHSIGN * DEPZI) ;

* ---- Actualisation des points milieux

TAB1.<CHP_X1 = CHP_X1 ;
TAB1.<CHP_Y1 = CHP_Y1 ;
TAB1.<CHP_Z1 = CHP_Z1 ;

*MESS '---------------------------------> exiting @DMILIEU';
FINPROC DEPX0 DEPY0 DEPZ0 ;
**** @DMOYEN

DEBPROC @DMOYEN CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
                PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE;


*MESS '---------------------------------> calling @DMOYEN';

*--------------- VARIABLES D'ENTREE :
TYPCAL  = TAB1.<TYPE_CALCUL ;
*------------------------------------
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;
*
SI (EGA (TYPE CHSIGN) MOT) ;
* --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
   CHSIGN = 1. ;
FINSI ;

*        ---- Calcul du champ dans le repere global
         BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y
                                 CHP_Z ISHIFT IRIPPLE ;

*        ---- Calcul de la norme du champ

         NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;

*        ---- Calcul du point extremite par la methode des tangentes

         XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
         YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
         ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;



*        ---- Calcul du champ magnetique dans le repere global
*        ---- sur le point extremite


         BXG0 BYG0 BZG0 FSECU = @CHAMB TAB1 XG_NEW0 YG_NEW0
                                 ZG_NEW0 ISHIFT IRIPPLE ;


*         ---- Moyenne des champs magnetiques

          BXG1 = (BXG + BXG0)/2. ;
          BYG1 = (BYG + BYG0)/2. ;
          BZG1 = (BZG + BZG0)/2. ;


*        ---- Calcul de la norme du champ moyenne

          NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;

*        ---- Calcul des deplacements

         DEPX0 = BXG1 * PASB0 / NORM_B1 ;
         DEPY0 = BYG1 * PASB0 / NORM_B1 ;
         DEPZ0 = BZG1 * PASB0 / NORM_B1 ;

*MESS '---------------------------------> exiting @DMOYEN';
FINPROC DEPX0 DEPY0 DEPZ0 ;
**** @DPSI

DEBPROC @DPSI TAB1*TABLE ;

*************************************************************
* Procedure de calcul de dpsi en chaque point d'un maillage *
* donne.            Alain MOAL (Novembre 2001)              *
*************************************************************
*
MESS '---------------------------------> calling @DPSI';
*
*--------------- VARIABLES D'ENTREE :
CHB0   = TAB1.<CARTE_B    ;
GRILB0 = TAB1.<GRILLE_B   ;
MAIL1  = TAB1.<MAILLAGE_B ;
*------------------------------------
*TRAC (MAIL1 ET GRILB0) ;
CHEL1 = CHAN CHAM CHB0 GRILB0 ;
CHPO1 = PROI MAIL1 CHEL1 1.E-4;
CHDPSI = EXCO 'DPSI' CHPO1 ;
*
MESS '---------------------------------> exiting @DPSI';
FINPROC CHDPSI ;

**** @DREPROJ

DEBPROC @DREPROJ CHP_X*CHPOINT CHP_Y*CHPOINT CHP_Z*CHPOINT
        PASB0*FLOTTANT CHSIGN/CHPOINT TAB1*TABLE ;

****************************************************************
* Procedure de calcul du deplacement pour remonter des lignes  *
* de champ magnetique, a partir des CHPOINT de coordonnees     *
* methode utilisant une reprojection sur la SMF                *
* ---> construit un chpoint appuye sur l'objet etudie et       *
* contenant pour chaque point le deplacement sur un pas pour   *
* remonter les lignes de champ                                 *
****************************************************************

*MESS '---------------------------------> calling @DREPROJ';

*--------------- VARIABLES D'ENTREE :
TYPCAL  = TAB1.<TYPE_CALCUL ;
RR      = TAB1.<RR ;
EPS0    = TAB1.<EPS ;
NBOB    = TAB1.<NBOB  ;
COEFA   = TAB1.<COEFA ;
COEFB   = TAB1.<COEFB ;
COEFC   = TAB1.<COEFC ;
* (pour info) TAB1.<CHSIGN ;
*------------------------------------
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;
*
SI (EGA (TYPE CHSIGN) MOT) ;
* --- Cas ou l'appel vient d'une proc qui n'a pas calcule CHSIGN
   CHSIGN = 1. ;
FINSI ;


*        ---- Calcul du champ dans le repere global
         BXG BYG BZG FSECU = @CHAMB TAB1 CHP_X CHP_Y
                                 CHP_Z ISHIFT IRIPPLE ;


*        ---- Calcul de la norme du champ

         NORM_B = ((BXG*BXG) + (BYG*BYG) + (BZG*BZG))**0.5 ;


*
         XG_NEW0 = CHP_X + (CHSIGN * BXG * PASB0 / NORM_B) ;
         YG_NEW0 = CHP_Y + (CHSIGN * BYG * PASB0 / NORM_B) ;
         ZG_NEW0 = CHP_Z + (CHSIGN * BZG * PASB0 / NORM_B) ;

*        ---- Coordonnees dans le repere
*        ---- pseudo-toroidal du ripple
         RHOR THER PHIR = @CRGTC CHP_X CHP_Y CHP_Z RR 0. ;
         RHOR_OLD = RHOR ;
         KAUX = (EXP (THER ** 2 * -1. * COEFC))*
                      ((COS (PHIR * NBOB)) * -1. + 1.) * COEFA ;
         I3 = 0 ;
         REPETER BOUCLE3 50 ;
*           I3 =I3 + 1 ; MESS '     I3 =' I3 ;
            RHOR_NEW = RHOR + (KAUX * (EXP(RHOR_OLD * COEFB)));
            SI ((MAXI (ABS((RHOR_NEW - RHOR_OLD)/RHOR_NEW)))
                         <EG EPS0) ;
            QUITTER BOUCLE3 ;
            FINSI ;
            RHOR_OLD = RHOR_NEW ;
         FIN BOUCLE3 ;

         RHOMER = RHOR_NEW ;

         I2 = 0 ;
         REPETER BOUCLE2  2 ;
             I2 =I2 + 1 ;
*            MESS '     I2 =' I2 ;
*            ---- point sur la surface magnetique
             RHORN THERN PHIRN = @CRGTC XG_NEW0 YG_NEW0
                                        ZG_NEW0 RR 0. ;
             DRHOMERN = (EXP (RHOMER*COEFB))*(EXP(THERN**2
                                    *COEFC * -1.)) * COEFA ;
             RHORIP = DRHOMERN * ((COS(PHIRN * NBOB)) - 1.)
                                    + RHOMER ;

             XG_NEW1 YG_NEW1 ZG_NEW1 = @CRTGC RHORIP THERN
                                      PHIRN RR 0. ;
*
*            ---- Calcul du champ dans le repere global
             BXG0 BYG0 BZG0 FSECU0 = @CHAMB TAB1 XG_NEW1 YG_NEW1
                                 ZG_NEW1 ISHIFT IRIPPLE ;

*            ---- Moyenne des tangentes
             BXG1 = (BXG + BXG0)/2. ;
             BYG1 = (BYG + BYG0)/2. ;
             BZG1 = (BZG + BZG0)/2. ;

             NORM_B1 = ((BXG1*BXG1) + (BYG1*BYG1) + (BZG1*BZG1))**0.5 ;

             XG_NEW0 = CHP_X + (CHSIGN * BXG1 * PASB0 / NORM_B1) ;
             YG_NEW0 = CHP_Y + (CHSIGN * BYG1 * PASB0 / NORM_B1) ;
             ZG_NEW0 = CHP_Z + (CHSIGN * BZG1 * PASB0 / NORM_B1) ;

             SI (I2 EGA 2);
             XG_NEW = XG_NEW0 ;
             YG_NEW = YG_NEW0 ;
             ZG_NEW = ZG_NEW0 ;
             FINSI ;

          FIN BOUCLE2 ;

*        ---- Calcul des deplacements

          DEPX0 =  BXG1 * PASB0 / NORM_B1 ;
          DEPY0 =  BYG1 * PASB0 / NORM_B1 ;
          DEPZ0 =  BZG1 * PASB0 / NORM_B1 ;



*MESS '---------------------------------> exiting @DREPROJ';
FINPROC DEPX0 DEPY0 DEPZ0 ;
'DEBPROC' EPSCHL MOD_1*MMODEL  SI_13*MCHAM
                   TE0*CHPOINT  TE1*CHPOINT  TAB1/'TABLE   '   ;
SI (( NON ( EXISTE MAT_1)) ET   ( EXISTE TAB1))     ;
 I1   =  0                                 ;
 REPETER BOMA11                              ;
  I1 = I1 + 1                                   ;
  SI ( EXISTE (TAB1.ZONE_MAT)  I1 )                    ;
     MO1 = TAB1.MODL_MAT. I1                     ;
     TM_1 =    ( REDU TE1 TAB1.ZONE_MAT.I1  )                ;
     Y_1  = VARI  TM_1   TAB1.TETMAT.MO1.YOUN   YOUN    ;
     NU_1 = VARI  TM_1   TAB1.TETMAT.MO1.NU     NU     ;
     AL_1 = VARI  TM_1   TAB1.TETMAT.MO1.ALPH   ALPH     ;
     NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE'                           ;
     Y_1  = CHANGER CHAM Y_1  MO1 'RIGIDITE'                           ;
     AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE'                           ;
    TEX1     = TEXTE  'YOUN Y_1  NU  NU_1  ALPH AL_1'              ;
    IMOTM1               = DIME (MOTS  TAB1.TEXTMECA.I1)           ;
    SI ( IMOTM1   EGA 5  )                                        ;
     TEX1  =  TEXTE TEX1  'SIGY YM_1 '                           ;
     TITRE 'MAT' I1 ' YIELD MODULUS'             ;
     YM_1  =  VARI  TM_1   TAB1.TETMAT.MO1.SIGY     SIGY         ;
     YM_1  =  CHANGER CHAM YM_1  MO1 'RIGIDITE'                  ;
     TEX1     = TEXTE TEX1  'H H_1 '                        ;
     H_1 =  VARI  TM_1  TAB1.TETMAT.MO1.H    H              ;
     H_1 =  CHANGER CHAM H_1 MO1 'RIGIDITE'                 ;
   FINSI                                                    ;
   MA1  = MATR MO1 TEX1                                     ;
  SINON                                                      ;
   QUITTER BOMA11                                           ;
  FINSI                                                ;
  SI ( I1 EGA 1 )                                     ;
   MOD_1 = MO1                                        ;
   MAT_1 = MA1                                        ;
  SINON                                               ;
   MOD_1 = MOD_1 ET MO1                                        ;
   MAT_1 = MAT_1 ET MA1                                        ;
  FINSI                                                 ;
 FIN BOMA11                                            ;
FINSI                                              ;
 TAB1.MATTOT = MAT_1                               ;
  SI_11    = THETA   MAT_1     ( TE1 - TE0 )    ;
  FO1      = BSIGMA SI_11                             ;
  SI_12    = SI_13 + SI_11                                ;
  EPS_1    = ELAS MOD_1 SI_12 MAT_1
FINPROC   EPS_1                                              ;**** @EPTH
DEBPROC @EPTH CHT1*CHPOINT EV1*EVOLUTION MOD1*MMODEL;

CHT2 = REDU CHT1 ( EXTR MOD1 'MAIL');
ALP1 = VARI MOD1 CHT2 EV1;
ALP2 = CHAN CHPO ALP1 MOD1 ;
ALP3 = NOMC ALP2 'SCAL' ;


EPS1 = ALP3 * CHT2;

EPX1 = NOMC EPS1 'EPXX';
EPY1 = NOMC EPS1 'EPYY';
EPZ1 = NOMC EPS1 'EPZZ';
GAXY1 = NOMC (0. * EPS1) 'GAXY';
GAXZ1 = NOMC (0. * EPS1) 'GAXZ';
GAYZ1 = NOMC (0. * EPS1) 'GAYZ';

EPX2 = CHAN CHAM EPX1 MOD1 'STRESSES';
EPY2 = CHAN CHAM EPY1 MOD1 'STRESSES';
EPZ2 = CHAN CHAM EPZ1 MOD1 'STRESSES';
GAXY2 = CHAN CHAM GAXY1 MOD1 'STRESSES';
GAXZ2 = CHAN CHAM GAXZ1 MOD1 'STRESSES';
GAYZ2 = CHAN CHAM GAYZ1 MOD1 'STRESSES';

EPS_THER = EPX2 ET EPY2 ET EPZ2 ET GAXY2 ET GAXZ2 ET GAYZ2;


FINPROC EPS_THER ;


**** @ET
DEBPROC  @ET CH1*CHPOINT CH2*CHPOINT ;
CHA1 = CHAN 'ATTRIBUT ' CH1  'NATURE'  'DISCRET' ;
CHA2 = CHAN 'ATTRIBUT ' CH2  'NATURE'  'DISCRET' ;
CHR = CHA1 ET CHA2;
FINPROC  CHR ;
**** @EVMAA
DEBPROC @EVMAA NOMM*MOT TIN1*FLOTTANT                      ;

 EVE2  = @EVMAT NOMM 'ALPHA'                               ;
 LLTE1 = EXTR  EVE2 'ABSC'                                ;
 KK1   = MINI ( ABS ( LLTE1 - (PROG (DIME LLTE1) * TIN1)));

 SI (KK1 EGA 0. 1. )                                      ;
  LLTE1 = LLTE1 + (PROG (DIME LLTE1) * 10.)               ;
  PP1   = @IPOE LLTE1 EVE2 FIXE                            ;
  EVE2  = EVOL MANU 'TEMPERATURE' LLTE1 'ALPH' PP1        ;
 FINSI                                                    ;

 EVOC700 = EVOL MANU 'TEMPERATURE' LLTE1
              'ALPH' (        PROG (DIME LLTE1) * (TIN1 - 20.))    ;

 EVOCT1  = EVOL MANU  'TEMPERATURE' LLTE1
              'ALPH' (LLTE1 - (PROG (DIME LLTE1) * 20.))           ;

 EVOCTY1 =  EVOL MANU 'TEMPERATURE' LLTE1  'ALPH'
   (PROG (DIME LLTE1) * ((TIN1 - 20.) * (EVMAT NOMM 'ALPHA' TIN1)));

 BETA1 = ((EVOCTY1 - (EVE2 * EVOCT1))/(EVOC700 - EVOCT1))          ;

FINPROC BETA1                     ;
**** @EVMAT
'DEBPROC' @EVMAT  MOT1*'MOT ' MOT2*'MOT ' VAL1/FLOTTANT CHP1/CHPOINT
                                                      TABTT/TABLE  ;
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
* version créee 19.12.96 par R. Mitteau pour fonctionner avec PASAPAS
*modification des noms de composantes :
* 'TEMPERATURE' -> 'T'
* 'CONDUCTIVITE' -> 'K'
* 'CAPACITE' -> 'CapaVolu'

SI  ( EXISTE TABTT)                                          ;
  TABT =  TABLE  TABTT                                        ;
 SINON                                                        ;
  TABT =  TABLE                                               ;
 FINSI                                                        ;
 TT1     =     TABLE                                          ;
REPETER BLOC1 1                                               ;

SI ( EGA MOT1 'DUNLOP' )                                       ;
* donnees bonnal 19 avril 93
 TT1.'DUNLOP' = TABLE                                          ;
 TT1.'DUNLOP' . 'K'   'T' = EVOL MANU
 'T' (PROG -500.  25.  50.  100. 150.  200. 250.  300. 350.
 400. 450.  500. 550.  600. 650. 700. 750. 800. 1000. 1500. 2000.
                    3.5E3)
 'K'(PROG 459. 459. 446. 418.  390.  364.  341.  320. 302.
  286. 273. 261. 250. 241. 233. 227. 220. 215. 190.  150.  110
                      51.) ;
*TITRE ' DUNLOP SPECIF HEAT'                  ;
 TT1.'DUNLOP' . 'C'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100. 150.   200.  250.
 300.  350.   400.    450.   500.  550.   600.   650.   700.   750.
 800. 1000. 1500. 2000. 3.5E3)
 'C'          (PROG 708. 708. 789.  937. 1066.  1178.  1274.
1357.  1431. 1495.4 1552.4 1603.2 1648.7 1689.7 1726.8 1760.5 1791.3
1819.6 1820. 2000. 2050. 2100.) ;

*TITRE ' DUNLOP DENSITY'                  ;
TT1.'DUNLOP' . 'RHO'    = EVOL MANU
'T' (PROG -500.  25. 50.  100.   150.  200.   250.
 300.  350.  400.  450.  500.  550.  600.  650.  700.   750.
800.  1000. 1500. 2000. 3.5E3)
 'RHO'    (PROG 1903.   1903. 1902. 1902. 1901. 1901. 1900.
1900. 1899. 1899. 1898. 1898. 1897. 1897. 1897. 1896. 1896.
1895. 1894. 1890. 1890. 1890. );

 EVRHOC   = (TT1.'DUNLOP' . 'RHO') * ( TT1.'DUNLOP' . 'C')  ;
TT1.'DUNLOP' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* N11 redensifie direction P
* materiau rentre par Raphael Mitteau le 6 juin 1996
* Source SEP lineaire entre 20 et 1000 C
SI ( EGA MOT1 'N11P_DENSE1' )                                       ;
*
* --- definition de la table
*
 TT1.'N11P_DENSE1' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'N11P_DENSE1' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20.  1000. )
 'K' (PROG  250. 250. 100.) ;
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
* N11 redensifie direction P
* materiau rentre par Raphael Mitteau le 6 juin 1996
* Source SEP a 20 et 1000 C copie variation N11
SI ( EGA MOT1 'N11P_DENSE2' )                                       ;
*
* --- definition de la table
*
 TT1.'N11P_DENSE2' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'N11P_DENSE2' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(150.))  +  (PROG 23. * 100.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Dunlop concept 1 conductivite dana la direction X mesure par CEA
* materiau rentre par Raphael Mitteau le 5 juin 1996
* source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
SI ( EGA MOT1 'DUN_C1_BONAL_X' )                                       ;
*
* --- definition de la table
*
 TT1.'DUN_C1_BONAL_X' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'DUN_C1_BONAL_X' . 'K'    = EVOL MANU
 'T' (PROG  -200. 25 50. 100. 150. 200. 250. 300. 350. 400.
                              450. 500. 550. 600. 650. 700. 750. 800. )
 'K' (PROG  430.6 430.6 425.7 406.5 382.4 358.0 335.1 314.4
 295.9 279.5 264.9 252. 240.5 230.2 221.0 212.7 205.3 198.5 ) ;
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Dunlop concept 1 conductivite dana la direction X mesure par CEA
* materiau rentre par Raphael Mitteau le 5 juin 1996
* source CEA/DRN/DMT 95-495 rapport de J.P. Bonal
SI ( EGA MOT1 'DUN_C1_BONAL_Y' )                                       ;
*
* --- definition de la table
*
 TT1.'DUN_C1_BONAL_Y' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'DUN_C1_BONAL_Y' . 'K'    = EVOL MANU
 'T' (PROG  -200. 25 50. 100. 150. 200. 250. 300. 350. 400.
                              450. 500. 550. 600. 650. 700. 750. 800. )
 'K'(PROG 102.4 102.4 102.4 99.9 95.6 90.8 86.0 81.4 77.2 73.4
   69.9 66.8 63.9 61.3 58.9 56.7 54.7 52.9  ) ;
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Sepcarb NB31 Version C conductivite dana la direction X
* materiau rentre par Raphael Mitteau le 5 juin 1996
* source SEP
SI ( EGA MOT1 'NB31CX' )                                       ;
*
* --- definition de la table
*
 TT1.'NB31CX' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
* --- approximation lineaire
 TT1.'NB31CX' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K' (PROG   323. 323. 154. 145. 145. ) ;

* --- variation copiee sur celle du N11
 TT1.'NB31CX' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(323. - 154.))  +  (PROG 23. * 154.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Sepcarb NB31 Version C conductivite dans la direction Y
* materiau rentre par Raphael Mitteau le 5 juin 1996
* source SEP
SI ( EGA MOT1 'NB31CY' )                                       ;
*
* --- definition de la table
*
 TT1.'NB31CY' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*

* --- approximation lineaire

 TT1.'NB31CY' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K'(PROG   117. 117. 58. 56. 56. ) ;

* --- variation copiee sur celle du N11

 TT1.'NB31CY' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(117. - 58. ))  +  (PROG 23. * 58.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Sepcarb NB31 Version C conductivite dans la direction Z
* materiau rentre par Raphael Mitteau le 5 juin 1996
* source SEP
SI ( EGA MOT1 'NB31CZ' )                                       ;
*
* --- definition de la table
*
 TT1.'NB31CZ' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'NB31CZ' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K'(PROG   115. 115. 55. 52. 52. ) ;
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;

***********************************************************************
* Sepcarb NS31 Version C conductivite dans la direction X
* materiau rentre par Raphael Mitteau le 10 septembre 1996
* source SEP
SI ( EGA MOT1 'NS31CX' )                                       ;
*
* --- definition de la table
*
 TT1.'NS31CX' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
* --- approximation lineaire
 TT1.'NS31CX' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K' (PROG   304. 304. 149. 141. 141. ) ;

* --- variation copiee sur celle du N11
 TT1.'NS31CX' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(304. - 149.))  +  (PROG 23. * 149.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Sepcarb NS31 Version C conductivite dans la direction Y
* materiau rentre par Raphael Mitteau le 10 septembre 1996
* source SEP
SI ( EGA MOT1 'NS31CY' )                                       ;
*
* --- definition de la table
*
 TT1.'NS31CY' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*

* --- approximation lineaire

 TT1.'NS31CY' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K'(PROG   100. 100. 55. 54. 54. ) ;

* --- variation copiee sur celle du N11

 TT1.'NS31CY' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(100. - 55. ))  +  (PROG 23. * 55.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
* Sepcarb NB31 Version C conductivite dans la direction Z
* materiau rentre par Raphael Mitteau le 10 septembre 1996
* source SEP
SI ( EGA MOT1 'NS31CZ' )                                       ;
*
* --- definition de la table
*
 TT1.'NS31CZ' = TABLE                                          ;
*
* --- definition de la conductivite thermique
*
 TT1.'NS31CZ' . 'K'    = EVOL MANU
 'T' (PROG  -200. 20. 800. 1000. 2000.)
 'K'(PROG    91.  91. 48. 43. 43. ) ;
*
* --- variation copiee sur celle du N11
*

 TT1.'NS31CZ' . 'K'    = EVOL MANU
 'T' (PROG  -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'  (((((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1
 165. 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6
 91.69 75.17 65.28 58.52 43.95) -
(PROG 23. * 102.6 ))/
(247.8 - 102.6))*(91. - 48. ))  +  (PROG 23. * 48.));
*
* --- tout est defini, on quitte les bloc de definition des materiaux
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;

***********************************************************************
* stands for DUNLOP CONCEPT 1
* valeurs rentrees le 04 mai 95 par J.F. Salavy

* source : DUNLOP LIMITED AVIATION DIVISION (net supply contract
* no 92-825A) envoyees par Ivi Smid le 29/03/95
* donnees entre 25 et 1200 C
* Pour cond_Z, les valeurs sont celles de la courbe et non du tableau

SI ( EGA MOT1 'DUN_CONCEPT1_X' )   ;

TT1.'DUN_CONCEPT1_X' = TABLE ;

 TT1.'DUN_CONCEPT1_X' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  25. 100. 200. 300. 400. 500. 600. 700.
                        800. 900. 1000. 1100. 1200. 2000. 5000.)
 'K'(PROG    112. 112. 106.  92.  84.  74.  67.  64.  57.
                         56.  50.  49.   45.   42.   30.   10. ) ;

 TT1.'DUN_CONCEPT1_X' . 'C'    = EVOL MANU
 'T' (PROG  -5000.  25. 100.  200.  300.  400.  500.  600.
                        700. 800. 900. 1000. 1100. 1200. 5000. )
 'C'          (PROG    710. 710. 934. 1171. 1363. 1506. 1621. 1706.
                     1779. 1835. 1884. 1924. 1960. 1990. 1990. ) ;

 TT1.'DUN_CONCEPT1_X' . 'RHO'    = EVOL MANU
 'T' (PROG  -5000.  25.  100.  200.  300.  400.  500.  600.
                        700. 800.  900. 1000. 1100. 1200. 5000. )
 'RHO'         (PROG   1910. 1910. 1907. 1905. 1903. 1900. 1896. 1893.
                       1890. 1887. 1885. 1883. 1880. 1880. 1880. );

 EVRHOC   =  ( TT1.'DUN_CONCEPT1_X' . 'RHO')
           * ( TT1.'DUN_CONCEPT1_X' . 'C');

 TT1.'DUN_CONCEPT1_X' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

QUITTER BLOC1                                                 ;
FINSI                                                         ;

SI ( EGA MOT1 'DUN_CONCEPT1_Y' )   ;

TT1.'DUN_CONCEPT1_Y' = TABLE ;

 TT1.'DUN_CONCEPT1_Y' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  25. 100. 200. 300. 400. 500. 600. 700.
                        800. 900. 1000. 1100. 1200. 2000. 5000. )
 'K'(PROG     78.  78.  73.  66.  59.  53.  48.  45.  40.
                         39.  37.  33.    33.   31.   30.   20. ) ;

 TT1.'DUN_CONCEPT1_Y' . 'C'    = EVOL MANU
 'T' (PROG  -5000.  25. 100.  200.  300.  400.  500.  600.
                        700. 800. 900. 1000. 1100. 1200. 5000. )
 'C'          (PROG    719. 719. 923. 1182. 1368. 1507. 1623. 1706.
                     1776. 1834. 1883. 1924. 1959. 1990. 1990. );

 TT1.'DUN_CONCEPT1_Y' . 'RHO'    = EVOL MANU
 'T' (PROG  -5000.  25.  100.  200.  300.  400.  500.  600.
                        700. 800.  900. 1000. 1100. 1200. 5000. )
 'RHO'         (PROG   1940. 1940. 1937. 1935. 1933. 1930. 1926. 1923.
                       1920. 1917. 1915. 1913. 1910. 1910. 1910. );

 EVRHOC   =  ( TT1.'DUN_CONCEPT1_Y' . 'RHO')
           * ( TT1.'DUN_CONCEPT1_Y' . 'C');

 TT1.'DUN_CONCEPT1_Y' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

QUITTER BLOC1                                                 ;
FINSI                                                         ;

SI ( EGA MOT1 'DUN_CONCEPT1_Z' )   ;

TT1.'DUN_CONCEPT1_Z' = TABLE ;

 TT1.'DUN_CONCEPT1_Z' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  20. 100. 200. 300. 400. 500. 600. 700.
                        800. 900. 1000. 1100. 1200. 2000. 5000. )
 'K'(PROG    351. 351. 330. 300. 275. 248. 225. 211. 190.
                        170. 150.  140.  125.  115.  100.  100. ) ;

 TT1.'DUN_CONCEPT1_Z' . 'C'    = EVOL MANU
 'T' (PROG  -5000.  25. 100.  200.  300.  400.  500.  600.
                        700. 800. 900. 1000. 1100. 1200. 5000. )
 'C'          (PROG    695. 695. 923. 1173. 1362. 1508. 1620. 1706.
                     1777. 1837. 1883. 1925. 1960. 1989. 1989. );

 TT1.'DUN_CONCEPT1_Z' . 'RHO'    = EVOL MANU
 'T' (PROG  -5000.  25.  100.  200.  300.  400.  500.  600.
                        700. 800.  900. 1000. 1100. 1200. 5000. )
 'RHO'         (PROG   1800. 1800. 1797. 1795. 1793. 1790. 1786. 1783.
                       1780. 1777. 1775. 1773. 1770. 1770. 1770. );

 EVRHOC   =  ( TT1.'DUN_CONCEPT1_Z' . 'RHO')
           * ( TT1.'DUN_CONCEPT1_Z' . 'C');

 TT1.'DUN_CONCEPT1_Z' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************

LL1 =  (( EGA MOT1 'DUNX' ) OU  ( EGA MOT1 'I1DUNX' )
   OU ( EGA MOT1 'DUNY' ) OU  ( EGA MOT1 'I1DUNY' ));
SI LL1               ;
* Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
 TT1.'DUNX' = TABLE                            ;
*
 TT1.'DUNX' . 'K'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100. 150.  200. 250.  300. 350.
 400. 450.  500. 550.  600. 650. 700. 750. 800. 1000. 1500. 2000.
                    3.5E3)
 'K'(PROG 459. 459. 446. 418.  390.  364.  341.  320. 302.
  286. 273. 261. 250. 241. 233. 227. 220. 215. 190.  150.  110
                      51.) ;
*

 TT1.'DUNY' = TABLE                            ;
*
 TT1.'DUNY' . 'K'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100.   150.  200. 250.  300. 350.
 400. 450.  500. 550.  600. 650. 700. 750. 800. 1000. 1500. 2000.
                    3.5E3)
 'K'(PROG   92.  92. 91.3  89.  85.8  82.2  78.5  74.9 71.6
  68.5 65.6  63 60.6 58.4 56.4 54.5 52.8 51.2  45.  35.  22.
                      51.) ;
*
*
* Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
 TT1.'I1DUNX' = TABLE                            ;
*

 P_COEF = prog         .21  .21     .23    .26 .29 .33 .36 .39 .41
 .44  .46  .48  .5   .52  .52  .52  .52  .52  .515  .51  .5  .5 ;
 TT1.'I1DUNX' . 'K'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100. 150.  200. 250.  300. 350.
 400. 450.  500. 550.  600. 650. 700. 750. 800. 1000. 1500. 2000.
                    3.5E3)
 'K'((PROG 459. 459. 446. 418.  390.  364.  341.  320. 302.
  286. 273. 261. 250. 241. 233. 227. 220. 215. 190.  150.  110
                      51.)*P_COEF) ;
*
 TT1.'I1DUNY' = TABLE                            ;
*
 P_COEF = prog         .21  .21     .23    .26 .29 .33 .36 .39 .41
 .44  .46  .48  .5   .52  .52  .52  .52  .52  .515  .51  .5  .5 ;
 TT1.'I1DUNY' . 'K'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100.  150.  200. 250. 300. 350.
 400. 450.  500. 550.  600. 650. 700. 750. 800. 1000. 1500. 2000.
                    3.5E3)
 'K' ((PROG   92. 92. 91.3 89.  85.8  82.2  78.5  74.9 71.6
  68.5 65.6  63 60.6 58.4 56.4 54.5 52.8 51.2  45.  35.  22.
                      51.)*P_COEF) ;
*
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;

****************************************************************&*****
SI ( EGA MOT1 'N112X' )                                       ;
* Valeurs fournies par Deschamps le 12/02/93 a 20. et 1000. degres C
 TT1.'N112X' = TABLE                            ;
*
 TT1.'N112X' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  210.  210.  125.  111.    80.   69.   51.  51.) ;
*
 TT1.'N112X' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.   1000.   2000. 4.5E3   )
 'ALPH'     (PROG  2.7E-6 2.7E-6 2.9E-6 3.3E-6 4.0E-6 4.0E-6 );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N112Y' )                                       ;
 TT1.'N112Y' = TABLE                            ;
*
 TT1.'N112Y' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  200.  200.  120.  102.    76.   62.   49.  49.) ;
*
 TT1.'N112Y' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.   1000.   2000. 4.5E3   )
 'ALPH'     (PROG  2.4E-6 2.4E-6 2.6E-6 3.0E-6 3.7E-6 3.7E-6 );
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
SI ( EGA MOT1 'N112Z' )                                       ;
 TT1.'N112Z' = TABLE                            ;
*
 TT1.'N112Z' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  174.  174.  92.   72.    60.   50.   45.  45.) ;
*
 TT1.'N112Z' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.   1000.   2000. 4.5E3   )
 'ALPH'     (PROG  2.2E-6 2.2E-6 2.4E-6 2.8E-6 3.5E-6 3.5E-6 );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N112P' )                                       ;
* donnees bonnal 19 avril 93
 TT1.'N112P' = TABLE                                          ;
 TT1.'N112P' . 'K'    = EVOL MANU
 'T' (PROG -500.    25.    50.  100.   150.  200.   250.
 300.  350.  400.  450.  500.  550.  600.  650. 700.  750. 800.
1000. 1500. 2000.  5.5E3)
 'K'(PROG  220.3  220.3 222.4 214.7   201. 186.9  173.4
 161.3 150.7 141.3 133.1 125.9 119.6 114. 109. 104.6 100.6 97.
 90.   70.  60.    58.) ;
*TITRE ' N112P SPECIF HEAT'                  ;
 TT1.'N112P' . 'C'    = EVOL MANU
 'T' (PROG -500.  25.  50.  100. 150.   200.  250.
 300.  350.   400.    450.   500.  550.   600.   650.   700.   750.
 800. 1000. 1500. 2000. 5.5E3)
 'C'          (PROG 669. 669. 770.3 935. 1063.2 1165.8 1249.7
1319.6 1378.8 1429.4 1473.4 1511.8 1545.7 1575.8 1602.7 1627.0 1648.9
1668.8 1748. 1950. 1950. 1950.) ;

*TITRE ' N112P DENSITY'                  ;
TT1.'N112P' . 'RHO'    = EVOL MANU
'T' (PROG -500.  25. 50.  100.   150.  200.   250.
 300.  350.  400.  450.  500.  550.  600.  650.  700.   750.
800.  1000. 1500. 2000. 5.5E3)
 'RHO'    (PROG 2010.   2010. 2010. 2010. 2010. 2009. 2009.
2009. 2009. 2009. 2008. 2008. 2008. 2008. 2008. 2007. 2007.
2007. 2007. 2007. 2007. 2007. );

 EVRHOC   = (TT1.'N112P' . 'RHO') * ( TT1.'N112P' . 'C')  ;
TT1.'N112P' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N112H' )                                       ;

 TT1.'N112H' = TABLE                                          ;
*
* TITRE ' N112  H CONDUCTIVITY'                               ;
 TT1.'N112H' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  210.  210.  123.  105.    76.   62.   52.  52.) ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N112' )                                       ;
 TT1.'N112' = TABLE                                          ;
*
 TT1.'N112' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  210.  210.  123.  105.    76.   62.   52.  52.) ;

*TITRE ' N112 SPECIF HEAT'                  ;
 TT1.'N112' . 'C'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'C'    (PROG  780.  780.  1430. 1580. 1890. 2030. 2060. 2060.) ;

*TITRE ' N112 DENSITY'                  ;
TT1.'N112' . 'RHO'    = EVOL MANU
'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'RHO'    (PROG 1820. 1820. 1820. 1820. 1820. 1820. 1820. 1820.);

 EVRHOC   = (TT1.'N112' . 'RHO') * ( TT1.'N112' . 'C')  ;
TT1.'N112' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
* valeurs donnee par Deschamps 28 le 16.02.93
 TT1.'N112' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (PROG 28.E9 28.E9   31.E9  34.E9     37.E9  37.E9);
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N11' )                                       ;
 TT1.'N11' = TABLE                            ;
*
*js 190296 TT1.'N11' . 'K'    = EVOL MANU
*js 190296 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
*js 190296 'K'(PROG  210.  210.  123.  105.    76.   62.   52.  52.) ;
 TT1.'N11' . 'K'    = EVOL MANU
 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165.
153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17
65.28 58.52 43.95) * ( 210./247.) );

*TITRE ' N11 SPECIF HEAT'                  ;
 TT1.'N11' . 'C'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'C'    (PROG  780.  780.  1430. 1580. 1890. 2030. 2060. 2060.) ;

*TITRE ' N11 DENSITY'                  ;
TT1.'N11' . 'RHO'    = EVOL MANU
'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'RHO'    (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.);

 EVRHOC   = (TT1.'N11' . 'RHO') * ( TT1.'N11' . 'C')  ;
TT1.'N11' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

* valeurs donnee par Deschamps 28 le 16.02.93
 TT1.'N11' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (PROG 28.E9 28.E9   31.E9  34.E9     37.E9  37.E9);
*
QUITTER BLOC1                                                 ;
FINSI                                                            ;

***************************************************************************
SI ( EGA MOT1 'N11_PPI' )                                       ;
 TT1.'N11_PPI' = TABLE                            ;

* ....Lipa...actualise les valeurs le 28.3.95..suivant mesures PPI.

 TT1.'N11_PPI' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'K'(PROG  246.  246.  165.  141.    94.   72.   52.  52.) ;

*TITRE ' N11_PPI SPECIF HEAT'                  ;
 TT1.'N11_PPI' . 'C'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'C'    (PROG  780.  780.  1430. 1580. 1890. 2030. 2060. 2060.) ;

*TITRE ' N11_PPI DENSITY'                  ;
TT1.'N11_PPI' . 'RHO'    = EVOL MANU
'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 4.5E3)
 'RHO'    (PROG 1750. 1750. 1750. 1750. 1750. 1750. 1750. 1750.);

 EVRHOC   = (TT1.'N11_PPI' . 'RHO') * ( TT1.'N11_PPI' . 'C')  ;
TT1.'N11_PPI' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
* valeurs donnee par Deschamps 28 le 16.02.93

 TT1.'N11_PPI' . 'YOUN'    = EVOL MANU
'T' (PROG    -500.   20.   500.  1000.   2000.  4.5E3 )
 'YOUN'      (PROG 28.E9 28.E9   31.E9  34.E9     37.E9  37.E9);

 TT1.'N11_PPI' . 'ALPH'    = EVOL MANU
'T'(PROG    -500.   20.   500.  1000.  2000. 4.5E3   )
 'ALPH'     (PROG  1.5E-6 1.5E-6 1.6E-6 1.7E-6 1.8E-6 1.9E-6 );

 TT1.'N11_PPI' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   3500.)
 'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'I1N112P' )                                       ;
* creation de ce materiau par J. SCHLOS le 22/09/94
* valeurs dans le plan, moyenne des directions x et y
* N112 // irradie at 640 deg C / 1.25 dpa.g
 TT1.'I1N112P' = TABLE                            ;
*
 TT1.'I1N112P' . 'K'    = EVOL MANU
 'T' (PROG -500. 25.   50. 100. 150. 200. 250. 300.
                      350. 400. 450. 500. 550. 600. 650. 700.
                      750. 800. 1000. 1500. 2000. 2500. 3500.)
 'K'((PROG 45.6 45.6 48.7 53.1 55.8 57.2 57.9 58.
                      57.8 57.4 56.8 56.1 55.4 54.7  54. 53.6
                       52.9 51.3 37.2 21.   11.3   6.2   1.9)  );
* Source :Bonnal telecopie a Deschamps   le 21 09 94
* extrapole au dessus de 600.

*TITRE ' I1N112P SPECIF HEAT'                  ;
 TT1.'I1N112P' . 'C'    = EVOL MANU
 'T' (PROG -500. 25.   50. 100. 150. 200. 250. 300.
                      350. 400. 450. 500. 550. 600. 650. 700.
                      750. 800. 1000. 1500. 2000. 2500. 3500.)
 'C'      ((PROG  666. 666. 750. 901. 1031. 1142. 1237. 1320.
                 1391.8 1455. 1511. 1561. 1605. 1645. 1651.4 1680.6
                 1707.1  1731.3 1865.8 2098.4 2281. 2433.4 2682.6 )  );


*TITRE ' I1N112P DENSITY'                  ;
TT1.'I1N112P' . 'RHO'  = EVOL MANU
'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 3500. )
 'RHO'        (PROG 2026. 2026. 2026. 2026. 2025. 2025. 2025. 2024.
 2024. 2024. 2023. 2023. 2023. 2023. 2022. 2022. 2022. 2022. 2022.
 2022. 2022. 2022. 2022.);
EVRHOC   = (TT1.'I1N112P' . 'RHO') * ( TT1.'I1N112P' . 'C')  ;
TT1.'I1N112P' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI  ;
**************************************************************************************
SI ( EGA MOT1 'N11P' )                                       ;
* creation de ce materiau par R. MITTEAU le 20/01/94
* valeurs dans le plan, moyenne des directions x et y
* MODIF Fred.ESC.   le  28/10/95 *****
* But de la manoeuvre :ameliorer la conductivite a haute temperature
* MODIF 1 : otpimisation au dela de 800 degC

 TT1.'N11P' = TABLE                            ;
 TT1.'N11P' . 'K'    = EVOL MANU
 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K'((PROG 247.8 247.8 243.4 228.0 210.2 193.2 178.1 165.
 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 91.69 75.17
 65.28 58.52 43.95) * ( 240./247.) );

*ESC 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
*ESC  41. 41. 41.) * ( 240./247.) );

* MODIF 2 : MODIF 1 * ( 240./247.)
* 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 94.36 77.36
* 67.19 60.23 45.23) * ( 240./247.) );
* MODIF 3 : MODIF 2 * ( 1.05 )
* 153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 99.08 81.23
* 70.54 63.25 47.5) * ( 240./247.) );
* MODIF 4 : ORIGINAL * ( 1.1 )
*153.8 144.2 136. 129. 122.9 117.7 113.2 109.2 105.7 102.6 74.5 41.
*  41. 41. 41.) * ( 240./247.*1.1) );
* FIN MODIF Fred. ESC le 28/10/95 *****
* Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
* (registre de controle individuel)2129043
* extrapolees pour les temperatures superieures selon valeurs
* du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
* d'une base de donnee sur les composites carbone-carboneA05 A035
* N11 N112 envisages pour la fusion thermonucleaire
* Aout 1993, extrapollee exponentiellement au dela de  800 C

*TITRE ' N11P SPECIF HEAT'                  ;
 TT1.'N11P' . 'C'    = EVOL MANU
 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'C'    (PROG 672.8 672.8 763.9 920.5 1049.4 1156.6 1247.
1324. 1390.4 1448.2 1498.8 1543.6 1583.5 1619.2 1651.4 1680.6 1707.1
1731.3 1865.8 2098.4 2281. 2433.4 2682.6 )  ;
* source: rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
* d'une base de donnee sur les composites carbone-carboneA05 A035
* N11 N112 envisages pour la fusion thermonucleaire
* Aout 1993, extrapollee exponentiellement au dela de  800 C

*TITRE ' N11P DENSITY'                  ;
TT1.'N11P' . 'RHO'  = EVOL MANU
'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. )
 'RHO'        (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.
 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.
 1720. 1720. 1720. 1720.);

 EVRHOC   = (TT1.'N11P' . 'RHO') * ( TT1.'N11P' . 'C')  ;
TT1.'N11P' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'N11P' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 9.5E3   )
 'ALPH' ((1.42/6.)*(PROG  6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 ));
* Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
* extrapolees pour les temperatures superieures selon lois precedentes

 TT1.'N11P' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN' ((24.5/22.)*(PROG 22.E9 22.E9  24.3E9 26.7E9  29.E9  29.E9));
* Source : Valeur a 20 C donnee par Chappuis selon mesures SEP
* extrapolees pour les temperatures superieures selon lois precedentes
*
 TT1.'N11P' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
 'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
* Pris egal a celui de A05 par defaut d'autre valeur
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 'N11H' )                                       ;
* creation de ce materiau par R. MITTEAU le 20/01/94

 TT1.'N11H' = TABLE                            ;
*
 TT1.'N11H' . 'K'    = EVOL MANU
 'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500.)
 'K' ((PROG 170.1 170.1 168.1 159. 147.9 137.0 127.2 118.5
 111. 104.5 98.9 94.1 89.9 86.2 82.9 80.1 77.6 75.3 56.3 32.3 18.6
 10.7 3.5 ) * (149.4/170.1));
* Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
* (registre de controle individuel) 2129043
* extrapolees pour les temperatures superieures selon valeurs
* du rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
* d'une base de donnee sur les composites carbone-carbone A05 A035
* N11 N112 envisages pour la fusion thermonucleaire
* Aout 1993, extrapollee exponentiellement au dela de  800 C

*TITRE ' N11H SPECIF HEAT'                  ;
 TT1.'N11H' . 'C'    = EVOL MANU
 'T' (PROG -500.  25.  50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. )
 'C'         (PROG 672.8 672.8 763.9 920.5 1049.4 1156.6 1247.
1324. 1390.4 1448.2 1498.8 1543.6 1583.5 1619.2 1651.4 1680.6 1707.1
1731.3 1865.8 2098.4 2281. 2433.4 2682.6 ) ;
* source rapport DMT/93-265, J.P. BONAL, Elements pour la constitution
* d'une base de donnee sur les composites carbone-carbone A05 A035
* N11 N112 envisages pour la fusion thermonucleaire
* Aout 1993, extrapollee y=a*(x**b) au dela de  800 C

*TITRE ' N11H DENSITY'                  ;
TT1.'N11H' . 'RHO'    = EVOL MANU
'T' (PROG -500. 25. 50. 100. 150. 200. 250. 300. 350. 400.
450. 500. 550. 600. 650. 700. 750. 800. 1000. 1500. 2000. 2500. 4500. )
 'RHO'        (PROG 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.
 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720. 1720.
 1720. 1720. 1720. 1720.);

 EVRHOC   = (TT1.'N11H' . 'RHO') * ( TT1.'N11H' . 'C')  ;
TT1.'N11H' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'N11H' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 9.5E3   )
 'ALPH'     ((PROG  6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 )
             * (2.67/6));
* Source : Valeur a 25 C donnee par Chappuis selon mesures SEP
* (registre de controle individuel)2129043
* extrapolee en T suivant loi ?

 TT1.'N11H' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (PROG 28.E9 28.E9   31.E9  34.E9     37.E9  37.E9);
* source : valeurs donnees par Deschamps le 16.02.93


 TT1.'N11H' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
 'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
* Pris egal a celui de A05 par defaut d'autre valeur
QUITTER BLOC1                                                 ;
FINSI                                                         ;
***********************************************************************
SI ( EGA MOT1 '5890PT' )                                       ;
 TT1.'5890PT' = TABLE                            ;
*
*TITRE ' 5890PT CONDUCTIVITY'                  ;
 TT1.'5890PT' . 'K'    = EVOL MANU
 'T' (PROG -200. 27. 200.  600. 800. 1000. 1500. 2000. 9.5E3)
 'K'( PROG  76. 76. 73.5  54.7 49.0 44.0  36.5  31.7  31.7);

 TT1.'5890PT' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'RHO'(PROG 1820. 1820. 1820. 1820. 1820. 1820. 1820. );

 TT1.'5890PT' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'C'(PROG 880. 880.  1520. 1940.  2110. 2280. 2280.);

 EVRHOC   = (TT1.'5890PT' . 'RHO') * ( TT1.'5890PT' . 'C');

 TT1.'5890PT' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
*
* caracteristiques mecaniques ajoutees par R. MITTEAU le 30 mars 1994

 TT1.'5890PT' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20. 200.   700.  1200. 1700. 2200. 9.5E3 )
 'YOUN'      (PROG 12.E9 12.E9 13.E9 14.E9  15.E9 15.5E9 14.4E9 14.4E9);
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90

 TT1.'5890PT' . 'ALPH'    = EVOL MANU
'T' (PROG  0.   20.  100.   700.  1200. 1700. 2200. 9.5E3 )
 'ALPH'  (PROG  4.2E-6 4.2E-6 4.3E-6 4.8E-6 5.2E-6 5.6E-6 6.E-6 6.E-6);
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90

 TT1.'5890PT' . 'NU'    = EVOL MANU
'T'(PROG  0.   20. 200.  700.  1200. 1700. 2200. 9.5E3 )
 'NU'        (PROG .09  .09  .09   .1    .11   .12   .12   .12  );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
QUITTER BLOC1                                                 ;
FINSI                                                         ;
*********************************************************************
SI ( EGA MOT1 'PYRO_GP' )                                       ;
 TT1.'PYRO_GP' = TABLE                            ;
*
*TITRE ' PYRO_GP CONDUCTIVITY'                  ;
 TT1.'PYRO_GP' . 'K'    = EVOL MANU
 'T' (PROG -200. 27. 200. 400.  600. 800. 1000.
  1200. 1400. 1600.  2000. 9.5E3)
 'K'( PROG 500. 500. 408. 350. 294. 260.  238.
  220.  203.  190.   190.  190. );

 TT1.'PYRO_GP' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'RHO'(PROG 2200. 2200. 2200. 2200. 2200. 2200. 2200. );

 TT1.'PYRO_GP' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'C'(PROG 880. 880.  1520. 1940.  2110. 2280. 2280.);

 EVRHOC   = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');

 TT1.'PYRO_GP' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'PYRO_GH' )                                       ;
*
 TT1.'PYRO_GH' = TABLE                            ;
*
*TITRE ' PYRO_GH CONDUCTIVITY'                  ;
 TT1.'PYRO_GH' . 'K'    = EVOL MANU
 'T' (PROG -200. 27. 200. 400.  600. 800. 1000.
  1200. 1400. 1600.  2000. 9.5E3)
 'K'( PROG   1.   1.   1.   1.    1.   1.    1.
    1.    1.    1.     1.    1. );

 TT1.'PYRO_GH' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'RHO'(PROG 2200. 2200. 2200. 2200. 2200. 2200. 2200. );

 TT1.'PYRO_GH' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 1500. 2000. 9.5E3)
 'C'(PROG 880. 880.  1520. 1940.  2110. 2280. 2280.);

 EVRHOC   = (TT1.'PYRO_GP' . 'RHO') * ( TT1.'PYRO_GP' . 'C');

 TT1.'PYRO_GH' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'TOYOTANSO' )                                       ;
 TT1.'TOYOTANSO' = TABLE                            ;
*
 LR1 = PROG  0. 20. 25. 50. 100. 150. 200. 250. 300. 350. 400.
          450. 500. 550. 600. 650. 700. 750. 800. 4500. ;
 LR2 = PROG 149.6 149.6 150.1 150.5 145.7 137.9 129.4 121.3 113.8
      107.0 100.8  95.3 90.4 86.0 82.0 78.5 75.2 72.2 69.5   69.5 ;
*TITRE ' TOYOTANSO CONDUCTIVITY'                  ;
 TT1.'TOYOTANSO' . 'K'    = EVOL MANU
 'T'  LR1
 'K' LR2 ;

 LD = PROG 1838 1838 1838 1837 1836 1835 1833 1832 1831 1829 1828 1827
           1825 1824 1823 1821 1820 1819 1817 1817 ;
 TT1.'TOYOTANSO' . 'RHO'    = EVOL MANU
 'T' LR1
 'RHO'         LD                                             ;

 LR4 = PROG 666.8 666.8 686.4 778.0 933.3 1059.2 1162.9 1249.7 1323.3
  1386.5 1441.2 1489.1 1531.4 1568.9 1602.5 1632.6 1659.9 1684.7 1707.3
                                                                1707.3 ;
 TT1.'TOYOTANSO' . 'C'    = EVOL MANU
 'T' LR1
 'C'LR4;

 EVRHOC   = (TT1.'TOYOTANSO' . 'RHO') * ( TT1.'TOYOTANSO' . 'C');

 TT1.'TOYOTANSO' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'A05P' )                                        ;

TT1.'A05P' = TABLE                                            ;

* 31/7/92 diminution de la conduc A05

*TITRE ' A05 // CONDUCTIVITY'                                 ;
 TT1.'A05P' . 'K'    = EVOL MANU
 'T' (PROG  -500.   23. 350. 500.  1000. 1500. 2000.  9.5E3)
 'K'(PROG   200.  200. 117.  97.    68.   55.   45.  45.) ;

*
 TT1.'A05P' . 'C'    = EVOL MANU
 'T' (PROG -5000. 20.   500.  1000. 2000. 9.5E3)
 'C'          ( PROG 880. 880. 1500.  1900. 2070. 2070.);

 TT1.'A05P' . 'RHO'    = EVOL MANU
 'T' (PROG -5000. 20.   500.  1000. 2000. 9.5E3)
 'RHO'         (PROG 1770. 1770. 1770. 1770. 1770. 1770.);

 EVRHOC   = (TT1.'A05P' . 'RHO') * ( TT1.'A05P' . 'C');

 TT1.'A05P' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'A05P' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 9.5E3 )
 'YOUN'      (PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9);

 TT1.'A05P' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 9.5E3   )
 'ALPH'     (PROG  1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 );

 TT1.'A05P' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
 'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'A05H' )                                       ;
 TT1.'A05H' = TABLE                            ;
*
*TITRE ' A05  H CONDUCTIVITY'                  ;
 TT1.'A05H' . 'K'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 9.5E3)
 'K'(PROG   95.  95.    60.   47.    30.   28.   26.  26.) ;

* alpha pris egal a 6 * alpha de A05P le 3 decembre 1993
* R.MITTEAU - J. SCHLOSSER
 TT1.'A05H' . 'ALPH'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 9.5E3   )
 'ALPH'     (PROG  6.E-6 6.E-6 6.6E-6 7.8E-6 9.E-6 9.0E-6 );

* toutes evolutions suivantes de A05 H prises egales a celle
* de A05P le 3 decembre 1993 R.MITTEAU - J. SCHLOSSER
 TT1.'A05H' . 'C'    = EVOL MANU
 'T' (PROG -5000. 20.   500.  1000. 2000. 9.5E3)
 'C'          ( PROG 880. 880. 1500.  1900. 2070. 2070.);

 TT1.'A05H' . 'RHO'    = EVOL MANU
 'T' (PROG -5000. 20.   500.  1000. 2000. 9.5E3)
 'RHO'         (PROG 1770. 1770. 1770. 1770. 1770. 1770.);

 EVRHOC   = (TT1.'A05H' . 'RHO') * ( TT1.'A05H' . 'C');

 TT1.'A05H' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;


 TT1.'A05H' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 9.5E3 )
 'YOUN'      (PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9);

 TT1.'A05H' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
 'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
********************************************************************************
SI ( EGA MOT1 'A05ORT3D' )                                       ;
* ce materiau est de l A05 orthotrope en 3 dimensions
* plans conducteurs dans la direction 2 - 3
* mis a jour le 22/12/93 par R. MITTEAU

 TT1.'A05ORT3D' = TABLE                            ;

*------------------------ Donnees thermiques

 TT1.'A05ORT3D' . 'K1'    = EVOL MANU
 'T' (PROG -500.  23.   350.  500.  1000. 1500. 2000. 9.5E3)
 'K'(PROG   95.  95.    60.   47.    30.   28.   26.  26.) ;
* ref : inconnue


 TT1.'A05ORT3D' . 'K2'    = EVOL MANU
 'T' (PROG  -500.   23. 350. 500.  1000. 1500. 2000.   4.5E3)
 'K'(PROG   200.  200. 117.  97.    68.   55.   45.  45.) ;
* ref Le Carbone Lorraine

 TT1.'A05ORT3D' . 'K3'    = EVOL MANU
 'T' (PROG  -500.   23. 350. 500.  1000. 1500. 2000.   4.5E3)
 'K'(PROG   200.  200. 117.  97.    68.   55.   45.  45.) ;
* reference Le Carbone Lorraine


TT1.'A05ORT3D' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 2000. 4.5E3)
 'C'          ( PROG 880. 880. 1500.  1900. 2070. 2070.);
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06


 TT1.'A05ORT3D' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 2000. 4.5E3)
 'RHO'         (PROG 1770. 1770. 1770. 1770. 1770. 1770.);
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06

 EVRHOC   = (TT1.'A05ORT3D' . 'RHO') * ( TT1.'A05ORT3D' . 'C');

 TT1.'A05ORT3D' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

*------------------------ Donnees mecaniques

 TT1.'A05ORT3D' . 'YG1'    = EVOL MANU
'T'(PROG  0.    20.  300.   500.   700.    900.   4000.)
 'YOUN'      (PROG 20.E9  20.E9 22.E9  24.E9  26.E9   26.E9   26.E9);
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06

 TT1.'A05ORT3D' . 'YG2'    = EVOL MANU
'T' (PROG  0.   20.  300.    500.  700.   900.   4000.)
 'YOUN'       (PROG 20.E9 20.E9 22.E9  24.E9   26.E9  26.E9   26.E9) ;
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06

 TT1.'A05ORT3D' . 'YG3'    = EVOL MANU
'T' (PROG  0.   20.   300.  500.   700.   900.   4000.)
 'YOUN'       (PROG 20.E9 20.E9  22.E9 24.E9  26.E9  26.E9   26.E9);
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06

 TT1.'A05ORT3D' . 'NU12'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
* ref : Le Carbone Lorraine, generalise pour toutes les T et directions

 TT1.'A05ORT3D' . 'NU23'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
* ref : Le Carbone Lorraine, generalise pour toutes les T et directions

 TT1.'A05ORT3D' . 'NU13'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
* ref : Le Carbone Lorraine, generalise pour toutes les T et directions


1PLUS = EVOL MANU
  'T' (PROG  0.  20.  300.  500.   700.   900.   4000.)
  'NU'          (PROG  1.   1.    1.    1.     1.     1.      1.);

TT1.'A05ORT3D' . 'G12' =
   TT1.'A05ORT3D' . 'YG3' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU12' ));
* ref : formule  G = E / (2 * (1 + nu)), a verifier en orthotrope

TT1.'A05ORT3D' . 'G23' =
   TT1.'A05ORT3D' . 'YG1' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU23' ));
* ref : formule  G = E / (2 * (1 + nu)), a verifier en orthotrope


TT1.'A05ORT3D' . 'G13' =
   TT1.'A05ORT3D' . 'YG2' /(2* (1PLUS + TT1.'A05ORT3D' . 'NU13' ));
* ref : formule  G = E / (2 * (1 + nu)), a verifier en orthotrope


* TT1.'A05ORT3D' . 'G12'    = EVOL MANU
*'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
* 'COULOMB'    (1.6*(PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9));
* TT1.'A05ORT3D' . 'G23'    = EVOL MANU
*'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
* 'COULOMB'    (1.7*(PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9));
* TT1.'A05ORT3D' . 'G13'    = EVOL MANU
*'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
* 'COULOMB'    (1.8*(PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9));

 TT1.'A05ORT3D' . 'ALP1'    = EVOL MANU
'T'(PROG 0.     20.    500.  1000. 2000.  4.5E3   )
 'ALPH'      (PROG 7.E-6 7.E-6 7.5E-6 8.0E-6 9.0E-6 10.0E-6 ) ;
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
* interpole a partir des valeurs a 20 C et 2000 C

 TT1.'A05ORT3D' . 'ALP2'    = EVOL MANU
'T'(PROG    0.      20.   500.   1000.  2000.  4.5E3  )
 'ALPH'      (PROG   0.7E-6 0.7E-6 0.9E-6 1.1E-6 1.5E-6 2.3E-6  );
* interpole a partir des valeurs a 20 C et 2000 C
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06

 TT1.'A05ORT3D' . 'ALP3'    = EVOL MANU
'T'(PROG    0.      20.    500.  1000.  2000. 4.5E3  )
 'ALPH'      (PROG   0.7E-6 0.7E-6 0.9E-6 1.1E-6 1.5E-6 2.3E-6 );
* ref : Principales caracteristiques des materiaux NET NT TS 51-90-06
* interpole a partir des valeurs a 20 C et 2000 C

QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************

SI ( EGA MOT1 'A05ORT2D' )                                     ;
* ce materiau est de l A05 orthotrope en 2 dimensions
* plans conducteurs dans la direction
 TT1.'A05ORT2D' = TABLE                            ;

*------------------------ Donnees thermiques

 TT1.'A05ORT2D' . 'K'    = EVOL MANU
 'T' (PROG  -500.   23. 350. 500. 1000. 1500. 2000.  4.5E3)
 'K'(PROG   200.  200. 117.  97.    68.   55.   45.  45.) ;


TT1.'A05ORT2D' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 2000. 4.5E3)
 'C'          ( PROG 880. 880. 1500.  1900. 2070. 2070.);

 TT1.'A05ORT2D' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   500.  1000. 2000. 4.5E3)
 'RHO'         (PROG 1770. 1770. 1770. 1770. 1770. 1770.);

 EVRHOC   = (TT1.'A05ORT2D' . 'RHO') * ( TT1.'A05ORT2D' . 'C');

 TT1.'A05ORT2D' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

*------------------------ Donnees mecaniques
* le 6/12/93, tout est bidon et ne sert qu a verifier
* que l orthotropie passe

 TT1.'A05ORT2D' . 'YG1'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9);

 TT1.'A05ORT2D' . 'YG2'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (1.3*(PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9));

 TT1.'A05ORT2D' . 'YG3'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'YOUN'      (1.5*(PROG 20.E9 20.E9   22.E9  24.E9     26.E9  26.E9));


 TT1.'A05ORT2D' . 'G12'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'COULOMB'    (1.6*(PROG 20.E9 20.E9   22.E9  24.E9   26.E9  26.E9));

 TT1.'A05ORT2D' . 'G23'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'COULOMB'    (1.7*(PROG 20.E9 20.E9   22.E9  24.E9   26.E9  26.E9));

 TT1.'A05ORT2D' . 'G13'    = EVOL MANU
'T' (PROG    0.   20.   500.  1000.      2000. 4.5E3 )
 'COULOMB'    (1.8*(PROG 20.E9 20.E9   22.E9  24.E9    26.E9  26.E9));

 TT1.'A05ORT2D' . 'ALP1'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 4.5E3   )
 'ALPH'     (PROG  1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 );
*
 TT1.'A05ORT2D' . 'ALP2'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 4.5E3   )
 'ALPH'     (1.3*(PROG  1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 ));

 TT1.'A05ORT2D' . 'ALP3'    = EVOL MANU
'T'(PROG    0.   20.   500.  1000.  2000. 4.5E3   )
 'ALPH'     (1.5*(PROG  1.E-6 1.E-6 1.1E-6 1.3E-6 1.5E-6 1.5E-6 ));

 TT1.'A05ORT2D' . 'NU12'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
*
 TT1.'A05ORT2D' . 'NU23'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );
*
 TT1.'A05ORT2D' . 'NU13'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   4000.)
'NU' (PROG       0.4  0.4      0.4      0.4     0.4    0.4     0.4 );

QUITTER BLOC1                                                 ;
FINSI                                                         ;
******************************************************************************
SI ( EGA MOT1 'B4C' )                                       ;
 TT1.'B4C' = TABLE                            ;

 TT1.'B4C' . 'K'    =EVOL MANU
 'T'  (PROG -200. 0. 50. 75. 100. 150. 200. 300. 400. 500.
 600. 650. 700. 750.  1000. 2000. 2.5E3 )
 'K' (PROG  0.5 .5  1.  1.1 1.15 1.1  1.   0.8  0.78 0.87
 1.12 1.4 1.75  2.2   4.45 13.45 18.);

* Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
*'Determination de la conductivite thermique d'un depot de B4C sur
* un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
* du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
* Valeurs representatives d'echantillons SNMI


 TT1.'B4C' . 'RHO'    = EVOL MANU
 'T'  (PROG -200. 20. 100. 200. 300. 400. 500. 600.
                                   800. 1000. 1500. 2000. 2.5E3)
 'RHO'(PROG 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3 1.3E3
                1.3E3 1.3E3 1.3E3 1.3E3 );

* Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
*'Determination de la conductivite thermique d'un depot de B4C sur
* un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
* du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
* Valeurs representatives d'echantillons SNMI


 TT1.'B4C' . 'C'    = EVOL MANU
  'T' (PROG -200. 20. 100. 200. 300. 400. 500. 600.
                                   800. 1000. 1500. 2000. 2.5E3)
  'C'    (PROG .5E3 .85E3 1.15E3 1.35E3 1.5E3 1.6E3 1.65E3
1.65E3 1.63E3 1.58E3 1.5E3 1.5E3 1.5E3)                    ;

* Valeurs rentrees le 30.01.1995 par R. Mitteau, d'apres le rapport
*'Determination de la conductivite thermique d'un depot de B4C sur
* un substrat cuivre' par D. Gosset, Rapport LEMA.DG.AD/95-003
* du 06.01.1995, valeurs extrapolees lineairement au dessus de 800C
* Valeurs representatives d'echantillons SNMI

EVRHOC   = (TT1.'B4C' . 'RHO') * ( TT1.'B4C' . 'C');

 TT1.'B4C' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;


*
 TT1.'B4C' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   200.    400.   600.   2000.)
 'YOUN'      (PROG 450.E9 450.E9 450.E9 450.E9 450.E9 450.E9);

 TT1.'B4C' . 'ALPH'    = EVOL MANU
'T'(PROG  0.   20.    200.    400.    500.   600.  2000.)
 'ALPH' (PROG  5.E-6  5.E-6  5.E-6   5.E-6   5.E-6  5.E-6  5.E-6 );

 TT1.'B4C' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

* valeurs non connues prises identiques AU CUCRZR

 TT1.'B4C' . 'SIGY'    = EVOL MANU
'T'(PROG  0. 20.    200.   400.   500.   600.   800.  2000.)
 'SIGY' (PROG 10.E6  10.E6  10.E6 10.E6  10.E6  10.E6   2.E6    0.  );

* TT1.'B4C' . 'H'    = EVOL MANU
*'T'(PROG     0.    20.     200.     400.   500.    600.
*                800.  1000.)
* 'H'  (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
*            312.5E6   10.E6  );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'BEHP' )                                       ;
* stands for BEryllium Hot Pressed
* valeurs rentrees le 18 mars 1994 par raphael MITTEAU
TT1.'BEHP' = TABLE                            ;

TT1.'BEHP' . 'K'    = EVOL MANU
'T' (PROG -200. 20. 100. 300. 500. 600. 800. 1000. 2000.
4000.)
'K'(PROG  187. 187. 149. 130. 108. 103. 99. 93. 77.
60. ) ;
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 300 500 600, Best Fit pour les autres (log)
* donnee en Watt/ metre * Kelvin

 TT1.'BEHP' . 'ALPH'    = EVOL MANU
'T'(PROG  -200. 20. 100. 500. 1000. 4000.    )
 'ALPH'     (PROG   11.3E-6 11.3E-6 13.5E-6 19.E-6 22.7E-6 27.9E-6);
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 100 500 1000, Best Fit pour les autres (puiss)
* donnee en [.]

 TT1.'BEHP' . 'C'    = EVOL MANU
 'T' (PROG  -200.   20.  100.  500. 1000. 1500. 4000.  )
 'C'          (PROG  1700. 1700. 2090. 2250. 2920. 3590. 3590. );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 100 500 1000 1500 C
* donnee en Joule par Kelvin et par Kilo
* ce jeu de valeurs montre sans doute un PB vers 100 C

 TT1.'BEHP' . 'RHO'    = EVOL MANU
 'T' (PROG -200.   20.  100.  500. 1000. 1500. 4000. )
 'RHO'         (PROG 1850. 1850. 1826. 1711. 1565. 1420.  1420. );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 et 1500 C, linearise pour les autres valeurs
* donnee en Kilo par metre cube

 EVRHOC   = (TT1.'BEHP' . 'RHO') * ( TT1.'BEHP' . 'C');

 TT1.'BEHP' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;


 TT1.'BEHP' . 'YOUN'    = EVOL MANU
'T' (PROG  -200.    20.    300.   500.  800.    4000.  )
 'YOUN'       (PROG 297.E9 297.E9  281.E9 270.E9 253.E9   72.E9  );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 600 et 800 C,  Best Fit pour les autres (lineaire)
* donnee Pascal


 TT1.'BEHP' . 'NU'    = EVOL MANU
'T'(PROG  -200. 20. 300. 500.  700.   900.   4000. )
 'NU'        (PROG   .08 .08  .08  .08   .08    .08     .08  );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90


 TT1.'BEHP' . 'SIGY'    = EVOL MANU
'T'(PROG  -200.    20.   200.   400.   600. 800.  1100.   )
 'SIGY'      (PROG 275.E6 275.E6 245.E6 210.E6 150.E6 25.E6  1.E6   );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeurs pour 20 a 800 C corrigees,
* extrapolees a vue au dessus en fonction de Temp Fusion
* donnees exprimees en Pascal

 TT1.'BEHP' . 'H'    = EVOL MANU
'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.)
 'H'          (PROG 8. * 400.E6 );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeur moyenne prise cste pour tout T
* donnees exprimees en Pascal

QUITTER BLOC1                                                ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'BE_ITER' )                                       ;
* stands for BEryllium hot pressed and sintered, fitted values
* valeurs rentrees le 29 mars 95 par J.F. Salavy

* source : ITER MATERIAL PROPERTIES HANDBOOK
* (draft, file code ITER-AL01-2101)
* envoyees par Ivi Schmid le 29/03/95 (excepte pour H)
* Pour Young, Poisson et yield, les polynomes donnent des valeurs
*   de 0 a 800C. Les valeurs suivantes sont intuitees mais
*   non exactes.

TT1.'BE_ITER' = TABLE                            ;

LTEMC1 = (PROG 20. PAS 39. 800.) ;

LCON1  = PROG ;
LRHO1  = PROG ;
LCSP1  = PROG ;
LALP1  = PROG ;
LYOU1  = PROG ;
LPOI1  = PROG ;
LYIE1  = PROG ;

I1 = 0 ;
REPE BOUC1 (DIME LTEMC1) ;
 I1 = I1 + 1 ;
 TEMPC1   = EXTR LTEMC1 I1 ;
 VALCON1 = (-1.0104E-07 * (TEMPC1 ** 3.))
         + ( 2.5429E-04 * (TEMPC1 ** 2.))
         + (-2.6939E-01 *  TEMPC1       )
         + ( 1.8980E+02                 ) ;
 LCON1 = LCON1 ET (PROG VALCON1) ;

 VALCSP1 = ( 1.2748E-06 * (TEMPC1 ** 3.))
         + (-3.1125E-03 * (TEMPC1 ** 2.))
         + ( 3.3358E+00 *  TEMPC1       )
         + ( 1.7418E+03                 ) ;
 LCSP1 = LCSP1 ET (PROG VALCSP1) ;

 VALRHO1 = (-1.5139E-05 * (TEMPC1 ** 2.))
         + (-6.9336E-02 *  TEMPC1       )
         + ( 1.8230E+03                 ) ;
 LRHO1 = LRHO1 ET (PROG VALRHO1) ;

 VALALP1 = ( 3.4457E-15 * (TEMPC1 ** 3.))
         + (-1.3462E-11 * (TEMPC1 ** 2.))
         + ( 2.1892E-08 *  TEMPC1       )
         + ( 1.0822E-05                 ) ;
 LALP1 = LALP1 ET (PROG VALALP1) ;

 VALYOU1 = (-7.6042E+02 * (TEMPC1 ** 3.))
         + ( 3.8393E+05 * (TEMPC1 ** 2.))
         + (-8.6726E+07 *  TEMPC1       )
         + ( 3.0961E+11                 ) ;
 LYOU1 = LYOU1 ET (PROG VALYOU1) ;

 VALPOI1 = (-2.5E-05 *  TEMPC1       )
         + ( 0.0715                  ) ;
 LPOI1 = LPOI1 ET (PROG VALPOI1) ;

 VALYIE1 = ( 8.5157E-02 * (TEMPC1 ** 3.))
         + (-4.1428E+02 * (TEMPC1 ** 2.))
         + ( 4.4811E+04 *  TEMPC1       )
         + ( 2.2464E+08                 ) ;
 LYIE1 = LYIE1 ET (PROG VALYIE1) ;

FIN BOUC1 ;

LTEMPT = (PROG -200.) ET LTEMC1 ET (PROG 1250. 10000.) ;

LCON1T = (PROG (EXTR LCON1 1)) ET LCON1 ET (PROG 60. 60.) ;
LCSP1T = (PROG (EXTR LCSP1 1)) ET LCSP1 ET (PROG 3540. 3540.) ;
LRHO1T = (PROG (EXTR LRHO1 1)) ET LRHO1 ET (PROG 1713. 1713.) ;
LALP1T = (PROG (EXTR LALP1 1)) ET LALP1 ET (PROG 2.4E-5 2.4E-5) ;
LYOU1T = (PROG (EXTR LYOU1 1)) ET LYOU1 ET (PROG 98.E+9 98.E+9) ;
LPOI1T = (PROG (EXTR LPOI1 1)) ET LPOI1 ET (PROG 0.0517 0.0517) ;
LYIE1T = (PROG (EXTR LYIE1 1)) ET LYIE1 ET (PROG 35.E+6 35.E+6) ;


TT1.'BE_ITER' . 'K' = EVOL MANU
'T' (LTEMPT) 'K'(LCON1T) ;

TT1.'BE_ITER' . 'C'           = EVOL MANU
'T' (LTEMPT) 'C'          (LCSP1T) ;

TT1.'BE_ITER' . 'RHO'          = EVOL MANU
'T' (LTEMPT) 'RHO'         (LRHO1T) ;

TT1.'BE_ITER' . 'ALPH'        = EVOL MANU
'T' (LTEMPT) 'ALPH'        (LALP1T) ;

TT1.'BE_ITER' . 'YOUN'        = EVOL MANU
'T' (LTEMPT) 'YOUN'        (LYOU1T) ;

TT1.'BE_ITER' . 'NU'      = EVOL MANU
'T' (LTEMPT) 'NU'          (LPOI1T) ;

TT1.'BE_ITER' . 'SIGY'        = EVOL MANU
'T' (LTEMPT) 'SIGY'        (LYIE1T) ;


EVRHOC   = (TT1.'BE_ITER' . 'RHO') * ( TT1.'BE_ITER' . 'C');

TT1.'BE_ITER' . 'CapaVolu'     = EVOL MANU
 'T' ( EXTR EVRHOC ABSC 1 )
 'CapaVolu' ( EXTR EVRHOC ORDO 1 ) ;


 TT1.'BE_ITER' . 'H'    = EVOL MANU
'T' (PROG 0. 20. 200. 400. 500. 600. 800. 4000.)
 'H'          (PROG 8. * 400.E6 );
* source : MATERIAL DATA for predesign Analysis of In Vessel Components
* compiled by E. Zolti The NET TEAM, internal Note, Revised 14.9.90
* valeur moyenne prise cste pour tout T
* donnees exprimees en Pascal

QUITTER BLOC1                                                 ;
FINSI                                                         ;

**********************************************************************
SI ( EGA MOT1 'MOLY' )                                       ;
 TT1.'MOLY' = TABLE                            ;
*
 TT1.'MOLY' . 'K'    = EVOL MANU
 'T' (PROG  -100.    20.    500.  1000. 1500. 2000.
                                                        2500.  2.5E3 )
 'K'(PROG   60.     60.    50.   35.   22.   10.
                                                         2.    2.  ) ;
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'TZM' )                                       ;
 TT1.'TZM' = TABLE                            ;
*
 TT1.'TZM'.'K'    = EVOL MANU
 'T' (PROG -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3 )
 'K'(PROG  125. 125. 115. 100.  87.   75.   67.   67.  ) ;
 TT1.'TZM' . 'C'    = EVOL MANU
 'T' (PROG  -200. 20. 500. 1000. 1500. 2000. 2500. 2.5E3)
 'C'          ( PROG 240. 240. 250.  290.  330.  400.  500. 500. );

 TT1.'TZM' . 'RHO'    = EVOL MANU
'T' (PROG -200. 20.  500. 1000.  1500. 2000. 2500.  2.5E3)
'RHO'  (PROG  10200. 10200. 10200. 10200. 10200. 10200. 10200. 10200.);

 EVRHOC   = (TT1.'TZM'.'RHO') * ( TT1.'TZM'.'C');

 TT1.'TZM' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'TZM' . 'YOUN'    = EVOL MANU
'T' (PROG -200.  20. 500.  1000.  1500.  2000. 2.5E3)
 'YOUN'      (PROG 300.E9 300.E9 260.E9 220.E9 140.E9 40.E9 40.E9);

 TT1.'TZM' . 'ALPH'    = EVOL MANU
'T'(PROG -200. 20.  500.  1000.  1500. 2000. 2500. 2.5E3 )
 'ALPH'(PROG 5.3E-6 5.3E-6 5.6E-6 6.0E-6 6.5E-6 7.2E-6 8.0E-6
         8.0E-6 );

 TT1.'TZM' . 'NU'    = EVOL MANU
'T'(PROG -200. 20.  300.  500. 700. 900. 2000. 2.5E3)
 'NU' (PROG       0.32 0.32 0.32  0.32  0.32 0.32  0.32  0.32 );

 TT1.'TZM' . 'SIGY'    = EVOL MANU
'T'(PROG -200. 20. 200. 400. 600. 800. 1000. 2.5E3 )
 'SIGY'  (PROG 6.E8 6.E8 4.5E8 4.25E8 3.5E8 3.E8 2.5E8 2.5E8  );

 TT1.'TZM' . 'H'    = EVOL MANU
'T' (PROG -200. 20. 200. 400. 600. 800.  1000. 2.5E3 )
 'H'  (PROG 1.1E9 1.1E9    1.1E9 1.1E9 1.1E9 1.1E9 1.1E9 1.1E9  );
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'TUNGSTEN' )                                    ;
 TT1.'TUNGSTEN' = TABLE                            ;
*
 TT1.'TUNGSTEN'.'K'    = EVOL MANU
 'T' (PROG -200. 20.  500. 1000. 1500. 2000. 2500. 3000.
3500. 4000. )
 'K'(PROG  130. 130. 120. 114.  105.   99.  95. 90.
85. 80.) ;
*Valeurs The NET TEAM, Valeurs de references ITER au dela

 TT1.'TUNGSTEN' . 'C'    = EVOL MANU
 'T' (PROG  -200. 20. 500. 1000. 1500. 2000. 2500. 3000.
3500. 4000.)
 'C'          ( PROG 140. 140. 150.  170.  180.  200. 220.  240.
260. 280. );
*Valeurs The NET TEAM, extrapolation lineaire au dela


 TT1.'TUNGSTEN' . 'RHO'    = EVOL MANU
'T' (PROG -200. 20.  500. 1000.  1500. 2000.  2500. 3000.
3500. 4000.)
'RHO'  (PROG  19200. 19200. 19200. 19200. 19200. 19200. 19200. 19200.
 19200. 19200.);
*Valeurs The NET TEAM, extrapolation lineaire au dela

 EVRHOC   = (TT1.'TUNGSTEN'.'RHO') * ( TT1.'TUNGSTEN'.'C');

 TT1.'TUNGSTEN' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'OFHC' )                                       ;
 TT1.'OFHC' = TABLE                            ;
*
 TT1.'OFHC' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  20.  200. 300.  400. 600. 800.
                                             1000. 2.5E3 )
 'K'(PROG   387. 387.  365. 351.5 338. 312. 291.
                                              273.  273. ) ;
* 'T' (PROG  -500.  20.      200. 300.  400. 600. 2.5E3 )
* 'K'(PROG   387. 387.      365. 351.5 338. 312. 312.) ;
*

 TT1.'OFHC' . 'C'    = EVOL MANU
 'T' (PROG -5000. 20.   200.   400.  600. 2.5E3)
 'C'( PROG 380. 380.  390.   400.  415. 415.);

 TT1.'OFHC' . 'RHO'    = EVOL MANU
 'T' (PROG -5000. 20.   200.   400.  600. 2.5E3)
 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);

 EVRHOC   = (TT1.'OFHC' . 'RHO') * ( TT1.'OFHC' . 'C');

 TT1.'OFHC' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'OFHC' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   200.    400.   600.   2000.)
 'YOUN'      (PROG 132.E9 132.E9 120.E9 103.E9  90.E9  29.E9);

 TT1.'OFHC' . 'ALPH'    = EVOL MANU
'T' (PROG  0.   20.    200.    400.    500.   600.  2000.)
 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6
 20.0E-6 );

 TT1.'OFHC' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

 TT1.'OFHC' . 'SIGY'    = EVOL MANU
'T'(PROG  0. 20.   200. 400.  500.  600.    800.  2000.)
 'SIGY'  (PROG 60.E6 60.E6 40.E6 20.E6 15.E6 10.E6   2.E6    0.  );

 TT1.'OFHC' . 'H'    = EVOL MANU
'T'
    (PROG     0.       20.      200.     400.      500.     600.
                800.  1000.)
 'H'  (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6    729.2E6    500.E6
            312.5E6   10.E6  );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'OFHCCYCL' )                                       ;
*
* Materiau entre le 19 septembre 1995 par R. Mitteau
*
* designation : Cuivre OFHC, proprietes mecaniques correspondant
* aux courbes d'ecrouissage cyclique
*
* Conductivite, rho, capacite calorifiques
* coefficient de Poisson prises identiques a OFHC
*
* Module d'young, SIGY et H d'apres
*
* High Temperature Torsional Low Cycle Fatigue of OFHC Copper
* Ahmet Aran and Dogan Erdun Gucer, Material Research Division,
* Marmara Research Institute...
* in Z. Metallkunde
*
* retravaille suivant CFP ...
*
*
*
 TT1.'OFHCCYCL' = TABLE                            ;
*
 TT1.'OFHCCYCL' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  20.  200. 300.  400. 600. 800.
                                             1000. 2.5E3 )
 'K'(PROG   387. 387.  365. 351.5 338. 312. 291.
                                              273.  273. ) ;

 TT1.'OFHCCYCL' . 'C'    = EVOL MANU
 'T' (PROG -5000. 20.   200.   400.  600. 2.5E3)
 'C'( PROG 380. 380.  390.   400.  415. 415.);

 TT1.'OFHCCYCL' . 'RHO'    = EVOL MANU
 'T' (PROG -5000. 20.   200.   400.  600. 2.5E3)
 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);

 EVRHOC   = (TT1.'OFHCCYCL' . 'RHO') * ( TT1.'OFHCCYCL' . 'C');

 TT1.'OFHCCYCL' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'OFHCCYCL' . 'YOUN'    = EVOL MANU
 'T'          (PROG -150. 20. 100. 200. 300. 400. 450. 500. 600.)
 'YOUN' (1.E9*(PROG  5.    5.   5.  5.   4.6  4. 2.5 1.2 .5 ));

 TT1.'OFHCCYCL' . 'ALPH'    = EVOL MANU
'T' (PROG  0.   20.    200.    400.    500.   600.  2000.)
 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6
 20.0E-6 );

 TT1.'OFHCCYCL' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

 TT1.'OFHCCYCL' . 'SIGY'    = EVOL MANU
'T'(PROG -150. 20. 100. 200. 300. 400. 450. 500. 600.)
'SIGY'  (1.E6 *(PROG 116. 116. 112. 100. 86. 65. 33. 14. 5. ));

 TT1.'OFHCCYCL' . 'H'    = EVOL MANU
'T'        (PROG  -150. 20. 100. 200. 300. 400. 450. 500. 600. )
'H' (1.E6 *(PROG 190. 190. 176. 154. 132. 110. 86. 62. 16. ));
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'INOX316L' )                                       ;
 TT1.'INOX316L' = TABLE                            ;
*
 TT1.'INOX316L' . 'K'    = EVOL MANU
 'T' (PROG  -200.  20.      500. 800.  1000. 4.5E3 )
 'K'(PROG    15.  15.       21.  26.    28.  28.) ;

 TT1.'INOX316L' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.        500. 800. 1000. 2.5E3)
 'C'          ( PROG 480. 480.       560. 610.  650.  650.);

 TT1.'INOX316L' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.        500.  800.  1000. 2.5E3)
 'RHO'        (PROG 7850.  7850.      7850. 7850. 7850. 7850. );

 EVRHOC   = (TT1.'INOX316L' . 'RHO') * ( TT1.'INOX316L' . 'C');

 TT1.'INOX316L' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'INOX316L' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   300.    500.   650.   2000. )
 'YOUN'      (PROG 190.E9 190.E9 170.E9 155.E9 145.E9 145.E9  );

 TT1.'INOX316L' . 'ALPH'    = EVOL MANU
'T'(PROG  0.   20.    400.    500.   700.  2000.)
 'ALPH' (PROG 16.2E-6 16.2E-6 17.8E-6 18.1E-6 18.7E-6 20.5E-6 );

 TT1.'INOX316L' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

 TT1.'INOX316L' . 'SIGY'    = EVOL MANU
*'T'(PROG  0.    20.    300.     500. 700.  2000. )
* 'SIGY'     (PROG 250.E6 250.E6 160.E6  140.E6 120.E6 120.E6 );
'T'(PROG  0.    20.    100.  200.    300.     400.
 500.  600. 900.  2000. )
 'SIGY'     (PROG 200.E6 200.E6 165.E6 132.5E6 112.5E6 100.E6
 93.8E6 85.E6  65.E6 65.E6);
 TT1.'INOX316L' . 'H'    = EVOL MANU
 'T'(PROG  0.    20.    100.   200.    300.     400.
 500.  600. 900. 2000.   )
 'H'  (PROG      10.E9    10.E9   8.25E9 7.0E9  6.E9     4.5E9
 4.5E9 4.5E9 4.5E9  4.5E9  );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'GLIDCOP' )                                       ;
 TT1.'GLIDCOP' = TABLE                            ;
*
 TT1.'GLIDCOP' . 'K'    = EVOL MANU
 'T' (PROG  -5000.  20.      200. 300.   500. 2.5E3 )
 'K'(PROG   348. 348.      325. 310.0  290. 290.) ;
* 'K'(PROG   391. 391. 385. 381. 377. 338.      312.) ;

 TT1.'GLIDCOP' . 'C'    = EVOL MANU
 'T' (PROG -5000. 20.   200.   300. 400. 500. 600. 2.5E3)
 'C'          ( PROG 380. 380.  400.   410. 413. 413. 413. 413.);

 TT1.'GLIDCOP' . 'RHO'    = EVOL MANU
 'T' (PROG -5000. 20.   200. 300.   400. 500.  600. 2.5E3)
 'RHO'        (PROG 8860. 8860. 8760. 8715. 8670. 8630. 8590. 8590.);

 EVRHOC   = (TT1.'GLIDCOP' . 'RHO') * ( TT1.'GLIDCOP' . 'C');

 TT1.'GLIDCOP' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

 TT1.'GLIDCOP' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   200.    500.   800.   2000.)
 'YOUN'      (PROG 130.E9 130.E9 120.E9  98.E9  75.E9  75.E9);

 TT1.'GLIDCOP' . 'ALPH'    = EVOL MANU
'T'(PROG  0.   20.    300.    500.   700.  2000.)
 'ALPH' (PROG 17.E-6 17.E-6 17.5E-6   18.5E-6 19.5E-6 19.5E-6 );

 TT1.'GLIDCOP' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

 TT1.'GLIDCOP' . 'SIGY'    = EVOL MANU
'T'(PROG  0.    20.    200.   300.   500.   2000. )
 'SIGY'     (PROG 424.E6 424.E6 313.E6 259.E6 169.E6 169.E6 );
* VALeurs prises egales au OFHC a controler

 TT1.'GLIDCOP' . 'H'    = EVOL MANU
'T'(PROG     0.    20.     200.     400.   500.    600.
                800.  1000.)
 'H'  (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
            312.5E6   10.E6  );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'OUTOKUMPU' )                                       ;
***********************************************************************
 TT1.'OUTOKUMPU' = TABLE                            ;
*
* seul valeur connue a 20 deg le reste pris proportionnellement a OFHC
 TT1.'OUTOKUMPU' . 'K'    = EVOL MANU
 'T' (PROG  -500.  20.      200. 300.   400. 600. 2.5E3 )
 'K'(PROG   355. 355.      335. 322.4  310. 286.  286.) ;
*OFHC
* 'T' (PROG  -500.  20.      200. 300.  400. 600. 2.5E3 )
* 'K'(PROG   387. 387.      365. 351.5 338. 312. 312.) ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'CUCRZR' )                                       ;
 TT1.'CUCRZR' = TABLE                            ;
*
*TITRE 'CUCRZR CONDUCTIVITY'                  ;
 TT1.'CUCRZR' . 'K'    = EVOL MANU
 'T' (PROG  -500.  20.      200. 300.  400. 600. 2.5E3 )
 'K'(PROG   343. 343.      351. 359.  359. 359. 312.) ;
 TT1.'CUCRZR' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   200.   400.  600. 2.5E3)
 'C'         ( PROG 376. 376.  376.   376.  376. 376.);

 TT1.'CUCRZR' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   200.   400.  600. 2.5E3)
 'RHO'(PROG 8890. 8890. 8890. 8890. 8890. 8890.);

 EVRHOC    = (TT1.'CUCRZR' . 'RHO') * ( TT1.'CUCRZR' . 'C');

 TT1.'CUCRZR' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;

* valeurs non connues prises identiques CU dependent de l'etat du metal
 TT1.'CUCRZR' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   200.    400.   600.   2000.)
 'YOUN'      (PROG 132.E9 132.E9 120.E9 103.E9  90.E9  29.E9);

 TT1.'CUCRZR' . 'ALPH'    = EVOL MANU
'T'(PROG  0.   20.    200.    400.    500.   600.
800. 1000.  2000.)
 'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 19.1E-6
 19.5E-6 20.0E-6);

 TT1.'CUCRZR' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

 TT1.'CUCRZR' . 'SIGY'    = EVOL MANU
'T'(PROG  0. 20.    200.   400.   500.   600.   800.  2000.)
 'SIGY' (PROG 210.E6 210.E6 200.E6 140.E6 100.E6 10.E6  2.E6    0.  );

 TT1.'CUCRZR' . 'H'    = EVOL MANU
'T'(PROG     0.    20.     200.     400.   500.    600.
                800.  1000.)
 'H'  (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
            312.5E6   10.E6  );
*
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'CUZR' )                                       ;
 TT1.'CUZR' = TABLE                            ;
*valeurs non connues prises -10%  au OFHC

 TT1.'CUZR' . 'K'    =EVOL MANU
 'T'  (PROG -200.  20.    200. 600. 1200. 2500. 2.5E3 )
 'K' (PROG  335. 335.    314. 270.  270.  270.  270.);

* valeurs non connues prises identiques au OFHC
 TT1.'CUZR' . 'C'    = EVOL MANU
 'T' (PROG -200. 20.   200.   400.  600. 2.5E3)
 'C'( PROG 380. 380.  390.   400.  415. 415.);

 TT1.'CUZR' . 'RHO'    = EVOL MANU
 'T' (PROG -200. 20.   200.   400.  600. 2.5E3)
 'RHO'(PROG 8750. 8750. 8650. 8560. 8480. 8480.);

 EVRHOC    = (TT1.'CUZR' . 'RHO') * ( TT1.'CUZR' . 'C');

 TT1.'CUZR' . 'CapaVolu'    = EVOL MANU
   'T' ( EXTR EVRHOC ABSC 1 )
   'CapaVolu'    ( EXTR EVRHOC ORDO 1 )                    ;
* valeurs non connues prises identiques AU CU
 TT1.'CUZR' . 'YOUN'    = EVOL MANU
'T' (PROG    0.   20.   200.    400.   600.   2000.)
 'YOUN'      (PROG 132.E9 132.E9 120.E9 103.E9  90.E9  29.E9);

 TT1.'CUZR' . 'ALPH'    = EVOL MANU
'T'(PROG  0.   20.    200.    400.    500.   600.  2000.)
'ALPH' (PROG 16.6E-6 16.7E-6 17.3E-6 18.1E-6 18.45E-6 18.7E-6 20.0E-6);

 TT1.'CUZR' . 'NU'    = EVOL MANU
'T'(PROG  0.   20.     300.    500.   700.    900.   2000.)
 'NU' (PROG  0.3    0.3    0.3     0.3     0.3     0.3     0.3 );

* valeurs non connues prises identiques AU CUCRZR

 TT1.'CUZR' . 'SIGY'    = EVOL MANU
'T'(PROG  0. 20.    200.   400.   500.   600.   800.  2000.)
 'SIGY' (PROG 210.E6 210.E6 200.E6 140.E6 100.E6 10.E6  2.E6    0.  );

 TT1.'CUZR' . 'H'    = EVOL MANU
'T'(PROG     0.    20.     200.     400.   500.    600.
                800.  1000.)
 'H'  (PROG 1190.5E6 1190.5E6 1041.7E6 875.E6 729.2E6 500.E6
            312.5E6   10.E6  );
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
SI ( EGA MOT1 'AL25' )                                       ;
 TT1.'AL25' = TABLE                     ;
*
*TITRE ' AL25 CONDUCTIVITY'             ;
 TT1.'AL25'. 'K'    = EVOL MANU
 'T' (PROG  -500.  20. 100. 200. 300. 400. 600. 2.5E3 )
 'K'(PROG   350. 350. 340. 327. 317. 300. 280. 280.) ;
QUITTER BLOC1                                                 ;
FINSI                                                         ;
**********************************************************************
FIN BLOC1                                                     ;
**********************************************************************
*
* Fin de la table de materiaux standarts
*
* Debut de la partie de la procedure qui retourne les donnees
*
**********************************************************************

SI (EXISTE TABT MOT1 )                                             ;
 SI ( EXISTE (TABT. MOT1) MOT2 )                                   ;
  EV1 = TABT . MOT1 . MOT2                                         ;
 SINON                                                             ;
  SI ( EXISTE TT1 MOT1 )                                           ;
   SI ( EXISTE (TT1. MOT1) MOT2 )                                  ;
    EV1 = TT1 . MOT1 . MOT2                                        ;
   SINON                                                           ;
    MESS '>>> Material ' MOT1 ' exists by you and in standard'     ;
    MESS '>>> the property ' MOT2 ' of the material ' MOT1
           ' is not defined in your data'
              ' nor is it in satandard'                            ;
    MESS '>>> Execution break-down by lack of data '               ;
    ERRE 'MATERIAL'                                                ;
   FINSI                                                           ;
  SINON                                                            ;
   MESS '>>> MAT ' MOT1 ' exists by you but not in standard'       ;
   MESS '>>> the property ' MOT2 ' of the material ' MOT1
        ' is not defined in your data'                             ;
   MESS '>>> Execution break-down by lack of data '                ;
   ERRE '  MATERIAL'                                               ;
  FINSI                                                            ;
 FINSI                                                             ;
SINON                                                              ;
 SI ( EXISTE TT1 MOT1 )                                            ;
  SI ( EXISTE (TT1. MOT1) MOT2 )                                   ;
   EV1 = TT1 . MOT1 . MOT2                                         ;
  SINON                                                            ;
   MESS '>>> The property ' MOT2 ' of the material '
          MOT1 ' is not defined in standard'    ;
   ERRE 'MATERIAL'                                                 ;
  FINSI                                                            ;
 SINON                                                             ;
  MESS '>>>> The material ' MOT1 ' is not defined in standard'     ;
  ERRE 'MATERIAL'                 ;
 FINSI                                                             ;
FINSI                                                              ;

SI ( EXISTE VAL1 )                                                 ;
  EV1 = IPOL VAL1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO')             ;
FINSI                                                              ;

SI ( EXISTE CHP1 )                                                 ;
  EV1 = IPOL CHP1 (EXTR EV1 'ABSC' ) (EXTR EV1 'ORDO')             ;
FINSI                                                              ;
*
*
*  Organisation :
*  --------------
*
*  La procedure est organisee en deux parties.
*
*  La premiere partie est une table standart contenant les
*  caracteristiques des materiaux usuels du groupe premiere paroi.
*  Les donnees sont regroupes dans le bloc BLOC1.
*
* d'abord : materiaux de surface
* puis    : materiaux intercalaires
* enfin   : materiaux de structure
*
*

*  Afin de ne pas surcharger la memoire de choses inutiles, un test
*  permet de ne lire les donnees du materiau que s'il est effectivement
*  appelle.
*  Des que le materiau a ete lu, on sort du bloc, car il n'est pas
*  necessaire de passer par tout les tests qui seront negatifs.
*
*  Les caracteristiques sont definies sous forme d'evolutions.
*
*  La deuxieme partie est la procedure proprement dite.
*  Elle est organisee sous forme de tests SI-SINON-FINSI.

*-------------------------------------------------------------------*
FINPROC EV1                                                        ;


'DEBPROC'  TELIGNSC
 MAIL_1*MAILLAGE CHP_1*CHPOINT
 P_DEB*POINT       P_FIN*POINT     CRIT*FLOTTANT  ;
********************************************************
*
* CETTE PROC. PERMET de reduire les valeurs du chpoint
*CHP_1 aux points les plus proche de la droite P_DEB P_FIN
* les points sont reperes  suivant la distance a P_DEB
*la proc. rend une evolution donnant la valeur
*en fonction de la distance
*
* j. schlosser 8 4 92
*
********************************************************
 LBRI1 = MAIL_1 POIN 'DROIT' P_DEB   P_FIN  CRIT       ;
 i1 = 0   ;
 opti elem seg2 ;
 repeter bou4 (( NBNO LBRI1) - 1 )  ;
  i1 = i1 + 1     ;
  po1 = LBRI1 poin i1 ;
  po2 = LBRI1 poin ( i1 + 1 ) ;
  si ( i1 ega 1 ) ;
   lbri2 = po1 d 1 po2 ;
  sinon ;
   lbri2 = lbri2 d 1 po2 ;
  finsi     ;
 fin bou4 ;
 XLBRI1 = COOR 1 LBRI2    ;
 YLBRI1 = COOR 2 LBRI2    ;
 NI1   = ( (( XLBRI1 - ( COOR 1 P_DEB )) ** 2 ) +
           (( YLBRI1 - ( COOR 2 P_DEB )) ** 2 )  )  ** 0.5  ;
 EVI1 = evol chpo (REDU CHP_1 LBRI2 ) scal LBRI2  ;
 EVI2 = evol chpo NI1 scal  LBRI2  ;
 EVIT1 = evol manu (EVI2 extr 'ORDO' 1 ) (EVI1 extr 'ORDO'1 ) ;
 dess ( evI1 et evI2 )     ;
FINPROC EVIT1              ;

*EVIT1 = TELIGNSC VBRIQT CHT1 P01  O67  1.E-3  ;
**** @FLNORM

DEBPROC @FLNORM TAB1*TABLE ;
*
**************************************************
* Procedure (inspiree de @OMBRAGE) permettant de *
* recuperer les valeurs du flux normalise en     *
* descendant les lignes de champ et en calculant *
* leur intersection avec le plan sur lequel la   *
* valeur du flux normalise est connue.           *
*          Alain MOAL (Fevrier 2001)             *
**************************************************
*
MESS '---------------------------------> calling @FLNORM';
*
*--------------- VARIABLES D'ENTREE :
MAIL1 = TAB1.LFLUX_EXTE ;
MAIL2 = TAB1.<MAILLAGE_FN ;
PASB1 = TAB1.<LONGUEUR_PAS_SANS_TEST ;
PASB2 = TAB1.<LONGUEUR_PAS_AVEC_TEST ;
*------------------------------------
*
*---- Champ magnetique sur le maillage "ombre"
TAB1.<MAILLAGE_B = MAIL1 ;
BR BZ BPHI = @MAGNB TAB1 ;
*
*---- signe pour descente de la ligne (+ si bz < 0)
TAB1.<CHAMP_SIGNE = BZ * (-1.) / (ABS BZ) ;
*
*---- distance a parcourir sans test d'intersection
CHZ = COOR 3 MAIL1 ;
Z0 = COOR 3 (MAIL2 POIN 1) ;
DMAX1 = (MINI (CHZ - Z0) 'ABS') * 0.9 ;
NBPAS1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
*
*---- distance a parcourir avec test d'intersection
DMAX2 = (MAXI (CHZ - Z0) 'ABS') * 2. - DMAX1 ;
NBPAS2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
*
*---- distance a parcourir
DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) ;
*
*---- calcul exp(-delta/lambdaQ).ABS(b.n) aux points
*---- d'intersection avec une methode analytique
TAB1.<NOMBRE_PAS_SANS_TEST = NBPAS1 ;
TAB1.<NOMBRE_PAS_AVEC_TEST = NBPAS2  ;
TAB1.<DISTANCE_SANS_TEST = DMAX1;
TAB1.<DISTANCE_AVEC_TEST = DMAX2 ;
*
CHFNORM = @ANADES TAB1 ;
*
*---- Champ magnetique sur les points d'intersection
TAB1.<MAILLAGE_B = EXTR CHFNORM 'MAIL' ;
TITRE 'TEST : MAILLAGE INITIAL DEFORME ';
TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B)
       ET (TAB1.<MAILLAGE_FN));
*
BR BZ BPHI = @MAGNB TAB1 ;
*
PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
BX = BR * (COS PHI) - (BPHI * (SIN PHI));
BY = BR * (SIN PHI) + (BPHI * (COS PHI));
*AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
*
*---- Calcul de b.n sur le maillage "ombrant"
B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
VBVN = (ABS BZ) / B_NORM ;
*
*---- calcul de exp (-delta/lambdaQ)
VAR1 = CHFNORM / VBVN ;
*
*---- on retrouve la forme initiale de TAB1.<S_OMBRE
FORM (TAB1.<DEPLACEMENT * (-1.)) ;
TITRE 'TEST : RETOUR FORME INITIALE' ;
TRAC ((TAB1.<MAILLAGE_B) ET MAIL1 ET (TAB1.<GRILLE_B)
       ET (TAB1.<MAILLAGE_FN));

MESS '>@FLNORM> distance covered :' TAB1.<LONGUEUR_PARCOURUE;

SI (EGA (TAB1.<LONGUEUR_CONNEXION_MAX) 0.) ;
   MESS '>@FLNORM> no interception found';
SINON;
   MESS '>@FLNORM> mini - maxi connection length'
        (mini TAB1.<CHAMP_DISTANCE) TAB1.<LONGUEUR_CONNEXION_MAX ;
FINSI;
*
MESS '---------------------------------> exiting @FLNORM';
FINPROC VAR1 ;

**** @FLUCRIT
DEBPROC @FLUCRIT TAB1*TABLE                           ;
*
* --- entrees
*
CHOIX    = TAB1.'CHFCORRELATION';
NIVEAU   = TAB1.'NIVEAU' ;
*
* --- racine
*
SI (NIVEAU >EG 4 ) ;
 MESS '-----------------------------------> calling @FLUCRIT'  ;
FINSI ;
* Calculs thermohydrauliques et bilans thermiques
* en attendant de les passer dans thersch1


*
* --- traitement
*
I1 = 1                                                         ;
REPETER BOUC1 (DIME CHOIX)                                        ;
 ICHOIX = EXTR  CHOIX I1                                          ;
 LOGI1  = EGA ICHOIX 'BOWR'                                     ;
 LOGI2  = EGA ICHOIX 'TONG'                                      ;
 LOGI3  = EGA ICHOIX 'CELA'                                     ;
 LOGITOT1 = LOGI1 OU LOGI2 OU LOGI3                              ;
 SI (NON LOGITOT1)                                               ;
  ERRE '@FLUCRIT mot cle different de BOWR,TONG ou CELA' ;
 FINSI                                                           ;
*
* --- Bowring72
*
 SI (EGA ICHOIX 'BOWR')                                        ;
  TIN1    = TAB1.'T_IN'                                        ;
  PRESS1  = TAB1.'P_IN'                                       ;
  VITESS1 = TAB1.'V_IN'                 ;
  EL      = TAB1.'L_HEATED'                                          ;
  XL1     = TAB1.'WE_HEATED'                                         ;
  D1      = TAB1.'D_MAQUETTE'                                      ;
  YTWIST  = TAB1.'TWIST_RATIO'                                      ;
  TTAPE   = TAB1.'T_TAPE'                                           ;
  PI  = 3.14159                                                    ;
  SI ( YTWIST EGA 0. )                                             ;
   TAB1.DHC = D1                                           ;
   S1  = PI * D1 * D1 / 4.                                          ;
   TAB1.DH = D1                                              ;
   FACV =  1.                                                      ;
   FACS =  1.                                                      ;
  SINON                                                            ;
   SI ( NON ( EXISTE  TAB1  'N_CANAUX' ))                  ;
      TAB1 . N_CANAUX = 2.                                        ;
   FINSI                                                          ;
   SS2  = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) )      ;
   S1   =  SS2 *    TAB1 . N_CANAUX                             ;
   QUAS = 4. * SS2                                            ;
   PERI =      ( ( PI * D1 / 2.) -  TTAPE + D1        )            ;
   TAB1.DH   =  QUAS / PERI                                  ;
  FINSI                                                           ;
  TAB1.T_IN = TIN1;
  TAB1.P_IN = PRESS1;
  TAB1.V_IN = VITESS1;
  @BOWRI72 TAB1                 ;
  QCHFW = TAB1.CHF ;
 FINSI                                                           ;
*
* --- Tong75
*
 SI (EGA ICHOIX 'TONG')                   ;
  @TABEAU TAB1                             ;
  VIN    = TAB1.V_IN                   ;
  TIN    = TAB1.T_IN                  ;
  PRES1  = TAB1.P_LOCAL                ;
  D1     = TAB1.D_MAQUETTE                ;
  EL     = TAB1.L_HEATED                  ;
  XL1    = TAB1.WE_HEATED                 ;
  TAB1.V_LOCAL = VIN ;
  SI ( NON ( EXISTE TAB1 TWIST_RATIO  ) )     ;
   TAB1 . TWIST_RATIO = 0.                    ;
  FINSI                                       ;
  YTWIST  = TAB1 . TWIST_RATIO                ;
  SI ( NON ( EXISTE TAB1 T_TAPE ) )           ;
   TAB1 . T_TAPE = 0.                         ;
  FINSI                                       ;
  TTAPE   = TAB1 . T_TAPE                     ;
  QSURFE = TAB1.V_FLUMOY1                 ;
  TSAT   =  @IPOE  PRES1  TAB1.EPTSAT      ;
  RHOIN  =  @IPOE  TIN    TAB1.ETRHOF      ;
  GIN    = RHOIN * VIN                    ;
  HIN    =  @IPOE  TIN    TAB1.ETHF        ;
  HSAT   =  @IPOE  TSAT   TAB1.ETHF        ;
  PI  = 3.14159                                           ;
 SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP FAUX ) )      ;
  TAB1.DHC = D1                                          ;
  S1  = PI * D1 * D1 / 4.                                  ;
  TAB1.DH = D1                                             ;
  FACV =  1.                                               ;
  FACS =  1.                                               ;
  TAB1.M_TONG = MOT 'TONG75'                               ;
* FACF =  1.                                                 ;
 FINSI                                                     ;
 SI ( NON ( EXISTE TAB1 HELI_WIRE ) )                         ;
  TAB1.HELI_WIRE = FAUX                                       ;
 FINSI                                                        ;
 SI ( NON ( EXISTE TAB1 HYPERVAP ) )                          ;
  TAB1.HYPERVAP = FAUX                                        ;
 FINSI                                                        ;
 SI ( ( YTWIST EGA 0. )  ET  ( EGA TAB1.HELI_WIRE VRAI ))    ;
  S1 = PI * D1 * D1 / 4.                                      ;
  SM = PI * TAB1.WIRE_D * TAB1.WIRE_D / 4.                    ;
  P1 = PI * D1                                                ;
  PM = PI * TAB1.WIRE_D                                       ;
  TAB1.DH = 4. * ( S1 - SM ) / ( P1 + PM )                    ;
  PIS2Y = PI / ( 2 * TAB1.PITCH_WIRE )                       ;
  FACV =  ( 1. + ( PIS2Y ** 2 ) ) ** 0.5                      ;
* FACV =  1.                                                 ;
  FACF =  1.                                                  ;
  TAB1.M_TONG = MOT 'TONG75'                                  ;
 FINSI                                                        ;
*
 SI ( NON ( EXISTE TAB1 HYPERVAP ) )                          ;
  TAB1.HYPERVAP = FAUX                                        ;
 FINSI                                                        ;
 SI ( ( YTWIST EGA 0. ) ET ( EGA TAB1.HYPERVAP VRAI ) )    ;
  SM =  ( TAB1 . LARG_CANAL * TAB1 . HMIN_CANAL ) +
      ( 2. * ( TAB1 . LARG_ESP * TAB1 . HFIN ) )              ;
  PM = TAB1 . LARG_CANAL + ( 2.* TAB1 . HMAX_CANAL ) +
      ( 2. * TAB1 . LARG_ESP ) + ( 2. * TAB1 . HFIN ) +
        TAB1 . LFIN                                         ;
  TAB1.DH = 4. * SM / PM                                     ;
  FACV =  1.                                                 ;
  FACF =  1.                                                 ;
  TAB1.HYP_SM = SM ;
 FINSI                                                       ;
*
 SI ( YTWIST > 0. )                                        ;
  SI ( NON ( EXISTE  TAB1  'N_CANAUX' ))                   ;
   TAB1 . N_CANAUX = 2.                                    ;
  FINSI                                                    ;
  SS2  = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) )    ;
  S1   =  SS2 *    TAB1 . N_CANAUX                         ;
  QUAS = 4. * SS2                                          ;
  PERI =      ( ( PI * D1 / 2.) -  TTAPE + D1        )     ;
  TAB1.DH   =  QUAS / PERI                                 ;
TAB1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1  ) ) /
                 ( ( PI * D1     ) -  ( TTAPE * 2.)  )       ;
  PIS2Y =           PI / ( 2. * YTWIST )                   ;
  FACV = ( 1. + ( PIS2Y ** 2 )  )  ** 0.5                  ;
  FACF =  1.15                                             ;
  FACS =  1.67                                             ;
  TAB1.M_TONG = MOT '1.67*TONG75'                          ;
 FINSI                                                     ;
 SI ( EGA TAB1.HYPERVAP VRAI ) ;
  HLOCAL =  HIN + (  QSURFE * XL1 * EL /
             ( GIN * TAB1.HYP_SM  ) )     ;
 SINON ;
  HLOCAL =  HIN + (  QSURFE * XL1 * EL / ( GIN * S1  ) )    ;
 FINSI ;
 SI ( HLOCAL < HSAT  )                                      ;
  SI ( HLOCAL >EG HIN  )                                    ;
   TLOCAL = @IPOE HLOCAL TAB1.EHFT                           ;
  SINON                                                     ;
   MESS '>@FLUCRIT> HLOCAL < HIN ?????====== '              ;
   ERREUR '>@FLUCRIT> HLOCAL < HIN'                         ;
  FINSI                                                     ;
 SINON                                                      ;
  TLOCAL = TSAT                                             ;
*   HLOCAL = HSAT                                             ;
 FINSI                                                      ;
 TAB1.'HLOCAL'  = HLOCAL ;
 @TONG75 TAB1                   ;
 QCHFW = TAB1.CHF ;
FINSI                                   ;
*
* --- Celata94
*
 SI (EGA ICHOIX 'CELA')   ;
  @CELAT94 TAB1           ;
  QCHFW = TAB1.CHF        ;
 FINSI                    ;
*
* --- fin des appels
*
 SI (EGA I1 1)                                                   ;
  L_QCHFW = PROG QCHFW                                           ;
 SINON                                                           ;
  L_QCHFW = L_QCHFW ET (PROG QCHFW)                              ;
 FINSI                                                           ;
 I1 = I1 + 1                                                     ;
FIN BOUC1                                                        ;

MESS '>@FLUCRIT> Critical Heat Flux output';
LIST L_QCHFW ;
*
* --- sorties
*
TAB1.'L_QCHFW' = L_QCHFW ;

SI (NIVEAU >EG 4 ) ;
 MESS '-----------------------------------> exiting @FLUCRIT'   ;
FINSI ;

FINPROC                                                   ;
**** @FLUXH
DEBPROC  @FLUXH TAB1*TABLE  ;
*---------------------------------------------------------------------
*                    Procedure @FLUXH
*---------------------------------------------------------------------
MESS '---------------------------------> calling @FLUXH';
V_DIM1 = VALEUR 'DIME' ;
S_TOT1 = TAB1.M_ILLAGE_TOT ;
COSDIR1 COSDIR2 COSDIR3 = @VNORM3D
          (EXTR TAB1.'MODELF' 'MAIL') (TAB1.LFLUX_EXTE) TAB1.'NIVEAU';
COTETF1 = COSDIR1 ;
SITETF1 = COSDIR2;
TETF1   =  ATG  SITETF1 ( COTETF1 + 1.E-12) ;

SI (EXISTE TAB1 'VAL_ANGLEI1');
 MESS '>>>>@FLUXH Le flux d electrons est forcement selon OY ';
 MESS '>>>>@FLUXH a l axe y, si autre angle tournez avec DEPL';
 ERRE '>>>>@FLUXH TAB1 VAL_ANGLEI1 inoperant ici';
FINSI                         ;

*1 DDDDDDDDDD  SI de niveau 1 : cas  DIMENSION 2

SI ( V_DIM1 EGA 2)  ;
 MESS '>@FLUXH> 2D ';
 VFON1  = TAB1.VPROFIL_W;
 XFON1  = TAB1.XPROFIL_W;
 LPAT1  = TAB1.LFLUX_EXTE;
 LPAT1D = TAB1.LFLUX_EXTE_DESS ;
 XLPAT1  = COOR 1 LPAT1;
 XLPAT1D = COOR 1  LPAT1D;
 XL_LPAT1 =  ABS (( MAXI XLPAT1 ) - ( MINI  XLPAT1 ));
 VFON2 = ( IPOL XLPAT1 XFON1 VFON1 )                 ;
 EVV1 = EVOL CHPO XLPAT1 SCAL LPAT1D                  ;
*dess EVV1 ;
 EVV2 = EVOL CHPO VFON2 SCAL LPAT1D                  ;
*dess EVV2 ;
 VVFON2 = EXTR EVV2 ORDO 1                           ;
 XXPAT1 = EXTR EVV1 ORDO 1                           ;
 TITRE ' INCIDENT GUN FLUX PROFILE '                 ;
 dess ( EVOL MANU XXPAT1 VVFON2 )                    ;
 SOM1   = SOMM  ( EVOL MANU XXPAT1 VVFON2 )          ;
 SOM1   =  ABS ( MAXI SOM1  )                        ;

* ajout RM le 27 10 95
 SI (EGA (VALE MODE) 'AXIS')                                ;
  MESS '>@FLUXH>  mode axisymetrique'                      ;
  SOM1   =(2. * 3.14159 *
           (SOMM  ( EVOL MANU XXPAT1 (VVFON2 * XXPAT1))))     ;
  SOM1   =  ABS ( MAXI SOM1  )                              ;
 FINSI                                                      ;
* fin locale de l ajout RM le 27 10 95

 FACFM1 = SOM1 / XL_LPAT1                            ;
 MESS '>@FLUXH> VALEUR integrale DU PROFIL'  SOM1;
 MESS '>@FLUXH> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
 MESS '>@FLUXH> VALEUR moyenne  DU PROFIL'  FACFM1;
 VPAT1  = VFON2 * SITETF1;
                                            (MINI VPAT1) (MAXI VPAT1);
 TAB1.'WE_HEATED_N'= XL_LPAT1 * (TAB1 . FSYM_X );
 TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1 . FSYM_X );
 VPUI_1 = FACFM1 * XL_LPAT1;
 TAB1.'V_FACFM1' = FACFM1;
 MESS '>@FLUXH> direct integration' VPUI_1 ;

*
* --- test puissance incidente
*

* calcul apres utilisation de l operateur flux

 FPAT1 = FLUX TAB1.'MODELF' VPAT1;
 VPUI_2 = (MAXI (RESU FPAT1));
 MESS '>@FLUXH> nodal  intergration ' VPUI_2;

 ERR_1  = VPUI_2 * 0.05;
 SI( NON ( EGA  VPUI_1 VPUI_2  ERR_1));
   MESS '>@FLUXH>  call the CONCEPTEUR ';
   ERREUR 'POWER BALANCE';
 SINON;
   MESS '>@FLUXH>  Ok Power Balance';
 FINSI;

 SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
 SI (NON (EXISTE TAB1 'V_SOM1'));
    TAB1.'V_SOM1'  = SOM1;
 SINON;
    TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
 FINSI;
* 1 MMMMMMMM SINON de niveau 1 : cas DIMENSION 3
SINON ;

 EXFLUX1  = TAB1.E_XPROFIL_W ;
 EZFLUX1  = TAB1.E_ZPROFIL_W ;

 SFLUX1  = TAB1.LFLUX_EXTE ;

 XSFLUX1 = COOR 1 SFLUX1 ;
 ZSFLUX1 = COOR 3 SFLUX1 ;

 VXFLUX2 = ( @IPOE XSFLUX1 EXFLUX1 FIXE )                ;
 VZFLUX2 = ( @IPOE ZSFLUX1 EZFLUX1 FIXE )                ;

 VXZFLUX2 = VXFLUX2 * VZFLUX2 * COSDIR2 ;
 PHFLUX1 =  FLUX  (TAB1.'MODELF') VXZFLUX2   ;
 VMOY1   = MAXI ( ( RESU PHFLUX1) / ( MESU SFLUX1 ) ) ;
 TAB1.'V_FACFM1'= VMOY1;
 SOM1 = (MAXI (RESU PHFLUX1))
                        * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
 SI (NON (EXISTE TAB1 'V_SOM1'));
    TAB1.'V_SOM1'  = SOM1;
 SINON;
    TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
 FINSI;
 VPAT1   = VXZFLUX2 / VMOY1 ;
*1 FFFFFFFFFF FINSI de niveau 1  : fin du test sur la dimension
FINSI ;
MESS '---------------------------------> exiting  @FLUXH';
FINPROC VPAT1                                         ;

**** @FLUXQP
*  Procedure @FLUXQP
*
*-----------------------------------------------------------------------
DEBPROC @FLUXQP TAB1*TABLE;
MESS '---------------------------------> calling @FLUXQP';
*
****** ATTENTION --> Cette procedure ne tourne pour l'instant qu'en 2D

V_DIM1  = VALEUR 'DIME' ;
SI ( V_DIM1 EGA 3)     ;
   MESS '@FLUXQP ne tourne pas en 3D';
   ERRE 'Dimension';
FINSI;

TAC1   =  TABLE;
TAC1.1 = 'MARQ TRIA ';
TAC1.2 = 'MARQ TRIB ';
TAC1.3 = 'MARQ ETOI ';
TAC1.4 = 'MARQ LOSA ';
TAC1.5 = 'MARQ CROI ';
TAC1.6 = 'MARQ PLUS ';
S_TOT1 = TAB1.M_ILLAGE_TOT ;
LPAT1 = TAB1.LFLUX_EXTE ;
LPAT1D = TAB1.LFLUX_EXTE_DESS ;
COSDIR1 COSDIR2 COSDIR3 = @VNORM3D
(EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';
COTETF1 = COSDIR1;
SITETF1 = COSDIR2;
TETF1   =  ATG  SITETF1 ( COTETF1 + 1.E-12) ;
SI (EXISTE TAB1 'VAL_ANGLEI1');
   SI (EXISTE TAB1 'CENTRE_PLASMA');
      ERREUR 'on ne peut avoir VAL_ANGLEI1 et CENTRE_PLASMA ' ;
   SINON;
      SINPA1 = COS ( (TETF1 * -1.)  + (TAB1.'VAL_ANGLEI1'));
      SIALPHA1 = ABS ( COS (TAB1.'VAL_ANGLEI1'));
      COALPHA1 = ABS ( SIN (TAB1.'VAL_ANGLEI1'));
      XXPAT1 = ABS ((COOR 1 LPAT1) - (COOR 1 TAB1.'PT_TGPLASMA'));
      YYPAT1 = ABS ((COOR 2 LPAT1) - (COOR 2 TAB1.'PT_TGPLASMA'));
      XLPAT1 = (XXPAT1*COALPHA1) + (YYPAT1*SIALPHA1);
      XLPAT3 = XLPAT1;
   FINSI;
SINON;
   SI (NON (EXISTE TAB1 'CENTRE_PLASMA'));
      ERREUR 'vous n avez pas donne TAB1.VAL_ANGLEI1';
   SINON;
      LOG1 = EGA (COOR 1 TAB1.'CENTRE_PLASMA')
                 (COOR 1 TAB1.'PT_TGPLASMA')   1.E-6;
      SI ( NON LOG1);
         ERREUR ' COOR 1 CENTRE_PLASMA ET PT_TGPLASMA DIFFERENTS ' ;
      FINSI;
      R0 = (COOR 2 TAB1.'CENTRE_PLASMA') - (COOR 2 TAB1.'PT_TGPLASMA');
      XXPAT1 = ((COOR 1 LPAT1) - (COOR 1 TAB1.'CENTRE_PLASMA'))    ;
      YYPAT1 = -1. * ((COOR 2 LPAT1) - (COOR 2 TAB1.'CENTRE_PLASMA')) ;
      RXY = ((XXPAT1 * XXPAT1)+(YYPAT1 * YYPAT1))** 0.5            ;
      ALPH1 = ATG XXPAT1 (YYPAT1 + 1.E-6)                     ;
      XLPAT1  = RXY - R0                                         ;
      SINPA1 = SIN ( ALPH1 + 90. - TETF1 )                    ;
      MASP1  = XXPAT1 MASQUE 'EGSUPE' 0.                 ;
      MASM1  = XXPAT1 MASQUE 'INFERIEUR' 0.                 ;
      XLPAT3 = (XLPAT1 * MASP1) - (XLPAT1 * MASM1)        ;
   FINSI;
FINSI;
MLAMB1 = ( TAB1 . 'LAMDAQ' ) * -1.                 ;
ELPAT1 = EXP  ( XLPAT1 / MLAMB1  )                 ;          ;
VPAT1  = ELPAT1 * (ABS SINPA1)                     ;
*********** cas LAMBDAQ VPAT1 = exp*sinus
TAC1.TITRE = TABLE ;

*TITRE 'SIN(teta)'                                  ;
EV1 = EVOL CHPO SINPA1 SCAL LPAT1D                 ;
*TITRE 'EXP(-DL/LAMB)'                              ;
EV2 = EVOL CHPO ELPAT1 SCAL LPAT1D                 ;
*TITRE 'SIN(teta)*EXP(-DL/LAMB)'                              ;
EV3 = EVOL CHPO VPAT1  SCAL LPAT1D                 ;
TAC1.1 = 'MARQ TRIA REGU '         ;
TAC1.TITRE.1 = 'SIN(teta)';
TAC1.2 = 'MARQ TRIB REGU TITR SIN(teta)'         ;
TAC1.TITRE.2 = 'EXP(-DL/LAMB)';
TAC1.3 = 'MARQ ETOI REGU TITR EXP(-DL/LAMB)'   ;
 TAC1.TITRE.3 = 'SIN(teta)*EXP(-DL/LAMB)'        ;
*TAC1.4 = 'MARQ LOSA REGU TITR EXP(-DL/LAMB)'         ;
*TAC1.5 = 'MARQ CROI REGU TITR SIN(teta)*EXP(-DL/LAMB)'  ;
*TAC1.6 = 'MARQ PLUS REGU TITR SIN(teta)*EXP(-DL/LAMB)'   ;
TITRE 'SIN,EXP,SIN*EXP'                              ;
DESS ( EV1 ET EV2 ET EV3 ) LEGE TAC1;
MESS ' MIN MAX DE EXP*SINa ' (MINI VPAT1) (MAXI VPAT1);
TITRE 'EXP(-DL/LAMB) fonction de DL '                 ;
EV4 = EVOL CHPO XLPAT3  SCAL LPAT1D                 ;
EV5 = ( EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
TITRE 'EXP(-DL/LAMB) fonction de DL ';
DESS EV5 LEGE;
SOM1   = SOMM EV5 ;
*********** cas LAMBDAQ VPAT1  =  exp*sinus
*********** cas LAMBDAQ SOM1   =  somme ( exp*sinus)
*********** cas LAMBDAQ FACFM1 =  SOM1 / largeur
SOM1   =  ABS (MAXI SOM1);
MESS '>@FLUXQP> VALEUR integrale DU PROFIL'  SOM1;
MESS '>@FLUXQP> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED );
XL_LPAT1 = ( ABS (( MAXI XLPAT1 ) - ( MINI  XLPAT1 )));
FACFM1 = SOM1 / XL_LPAT1;
MESS '>@FLUXQP> LARGEUR vue du plasma'  XL_LPAT1;
MESS '>@FLUXQP> VALEUR moyenne  DU PROFIL'  FACFM1;

SI (EXISTE TAB1 'LAMDAQ2');
   LPAT2 =  TAB1.LFLUX_EXT2              ;
   LPAT2D =  TAB1.LFLUX_EXT2              ;
   COSDIR1 COSDIR2 COSDIR3 = @VNORM3D S_TOT1 LPAT2  TAB1.'NIVEAU';
   COTETF2 = COSDIR1 * 1.          ;
   SITETF2 = COSDIR2 * 1.          ;
   COTETF1 =  @ET COTETF1  COTETF2         ;
   SITETF1 =  @ET SITETF1  SITETF2       ;
   TETF2   =  ATG  SITETF2 ( COTETF2 + 1.E-12) ;
   MESS '>>>>> 3B>>>>>>'               ;
   SINPA2 = COS ( (TETF2 * -1.)  + (TAB1.'VAL_ANGLEI2'));
   SIALPHA2 = ABS ( COS (TAB1.'VAL_ANGLEI2')) ;
   COALPHA2 = ABS ( SIN (TAB1.'VAL_ANGLEI2'));
   XXPAT2 = ABS ((COOR 1 LPAT2) - (COOR 1 TAB1.'PT_TGPLASMA'));
   YYPAT2 = ABS ((COOR 2 LPAT2) - (COOR 2 TAB1.'PT_TGPLASMA'));
   XLPAT2 = (XXPAT2*COALPHA2) + (YYPAT2*SIALPHA2);
   MLAMB2 = ( TAB1 . 'LAMDAQ2' ) * -1.;
   ELPAT2 = EXP  ( XLPAT2 / MLAMB2  );
   VPAT2  =  ELPAT2 * SINPA2;
   VPAT2  = VPAT2 + (( REDU VPAT2 TAB1.'PT_TGPLASMA') * -1.);
   VPAT1  = VPAT2 + VPAT1;
*   VPAT1  = VPAT2;
   TITRE 'SIN(teta)*EXP(-DL/LAMB)';
   TAC1   =  TABLE ;
   TAC1.1 = 'MARQ TRIA '         ;
   TAC1.2 = 'MARQ TRIB '         ;
   TAC1.3 = 'MARQ ETOI '         ;
   TAC1.4 = 'MARQ LOSA '         ;
   TITRE 'SIN(teta)';
   EV1 = EVOL CHPO SINPA2  SCAL LPAT2D;
   TITRE 'EXP(-DL/LAMB)'                              ;
   EV2 = EVOL CHPO ELPAT2  SCAL LPAT2D                 ;
   TITRE 'SIN(teta)*EXP(-DL/LAMB)';
   EV3 = EVOL CHPO VPAT2   SCAL LPAT2D                 ;
   EV4 = EVOL CHPO XLPAT2  SCAL LPAT2D                 ;
   DESS ( EV1 ET EV2 ET EV3 )                         ;
   MESS ' MIN MAX DE EXP*SIN22 ' (MINI VPAT2) (MAXI VPAT2);
   TITRE 'EXP(-DL/LAMB) fonction de DL, ligne 2 ';
   EV5 = (EVOL MANU (EXTR EV4 ORDO 1) (EXTR EV2 ORDO 1));
   TAC1.1 = 'MARQ TRIA TITRE EXP(-DL/LAMB)'         ;
   TAC1.2 = 'MARQ TRIB TITRE EXP(-DL/LAMB)'         ;
   DESS EV5 LEGE TAC1;
   SOM1   = SOM1 + (ABS ( MAXI (SOMM EV5) ))  ;
   MESS '>CFLUX_TO> VALEUR integrale DU PROFIL'  SOM1;
   MESS '>CFLUX_TO> LARGEUR MAQ. CHAUFFEE' (TAB1 . W_HEATED);
   XL_LPAT2 = ( ABS (( MAXI XLPAT2 ) - ( MINI  XLPAT2 )));
   XL_LPAT1 = XL_LPAT1 + XL_LPAT2;
   FACFM1 = SOM1 /  XL_LPAT1;
   MESS '>CFLUX_TO> VALEUR moyenne  DU PROFIL'  FACFM1;
FINSI;

TAB1.'WE_HEATED_R'= XL_LPAT1 * (TAB1.FSYM_X);
TAB1.'WE_HEATED'= XL_LPAT1 * (TAB1.FSYM_X);
VPUI_1 = FACFM1 * XL_LPAT1;
MESS ' PUIS. LINEIQUE PARTIE MAILLEE ON DOIT TROUVER ' VPUI_1 ;
FPAT1 = FLUX (TAB1.'MODELF') VPAT1   ;
VPUI_2 = ( MAXI (  RESU FPAT1   ));
ERR_1  = VPUI_2 * 0.05;
MESS ' >>>>> RESULTANTE  FLUX INCIDENT >>>>' VPUI_2;
SI( NON ( EGA  VPUI_1 VPUI_2  ERR_1));
  MESS '>> @FLUXQP: voir le CONCEPTEUR ';
*  ERREUR 'BILAN DES PUISSANCES';
FINSI;

SOM1 = SOM1 * (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX));
SI (NON (EXISTE TAB1 'V_SOM1'));
   TAB1.'V_SOM1'  = SOM1;
SINON;
   TAB1.'V_SOM1' = TAB1.'V_SOM1' + SOM1;
FINSI;
TAB1.'V_FACFM2'= FACFM1;
MESS '---------------------------------> Sortie de @FLUXQP';

FINPROC VPAT1;

**** @FLUXTOT
*-----------------------------------------------------------------------
*  Procedure @FLUXTOT
*-----------------------------------------------------------------------
DEBPROC @FLUXTOT TAB1*TABLE;
*
***********************************************************************
*       @FLUXTOT developpee par Nicolas URAGO (avr-sept 1994)         *
* largement revisitee par Jacques SCHLOSSER et Alain MOAL (aout 1995) *
***********************************************************************
******* ATTENTION --> Cette procedure ne tourne qu'en 3D et ne peut
*                     traiter que des cas de limiteurs plancher car
*                     Z (point tangent) = Z (centre du plasma)
*
MESS '---------------------------------> calling @FLUXTOT';
*
*-------------------- VARIABLES D'ENTREE
LPAT1  = TAB1.LFLUX_EXTE   ;
GRP1   = TAB1.GRAND_RAYON  ;
IMESS  = TAB1.'NIVEAU'     ;
PTG    = TAB1.'PT_TGPLASMA';
MODEL0 = TAB1.'MODELF'     ;
LAMBQ  = TAB1.LAMDAQ       ;
LISFLU = TAB1.LIS_FLUX     ;
OEIL0  = TAB1.VIEW_P       ;
*
SI (EXISTE TAB1 ANGLE_DEC) ;
   PSI = TAB1.ANGLE_DEC ;
SINON;
   PSI = 0.0 ;
FINSI;
*---------------------------------------
*
*---- On calcule pour chaque point de LPAT1, les coordonnees
*---- de son'centre plasma'.
XP1 = COOR 1 LPAT1 ;
YP1 = COOR 2 LPAT1 ;
ZP1 = COOR 3 LPAT1 ;
GRAYP1 = (XP1**2 + (YP1**2))**0.5 ;
XCP1 = XP1 * GRP1 / GRAYP1 ;
YCP1 = YP1 * GRP1 / GRAYP1 ;
*
AUX1 = ((XCP1 - XP1)**2 + ((YCP1 - YP1)**2))**0.5;
BETA1 = ATG (AUX1/ZP1) ;
ALPHA2 = ATG YCP1 XCP1 ;
*
*---- le vecteur tangent aux lignes de champ B est orthogonal
*---- a V = P1CP1
VX1 = XCP1 - XP1 ;
VY1 = YCP1 - YP1 ;
VZ1 = ZP1 * -1. ;
*
*---- B appartient au plan defini par les vecteurs K (0, 0, 1) et U
*UX1 = SIN (PSI + ALPHA2) ;
*UY1 = (COS (PSI + ALPHA2)) * -1. ;
*UZ1 = UX1 * 0. ;
*
UX1 = SIN (PSI - ALPHA2) ;
UY1 = COS (PSI - ALPHA2) ;
UZ1 = UX1 * 0. ;
*
*---- calcul de B
BZ = ((VZ1*UX1)**2 + ((VZ1*UY1)**2)) /
     ((VX1*UX1 + (VY1*UY1))**2) + 1. ;
BZ = BZ**(-0.5) * -1.;
BY = BZ * (VZ1*UY1) /(VX1*UX1 + (VY1*UY1)) * -1. ;
BX = BY * UX1 / UY1 ;
*
*---- Calcul du produit scalaire : VECTEUR TANGENT . NORMALE
NX NY NZ = @VNORM3D (EXTR MODEL0 'MAIL') LPAT1 IMESS ;
COS_BN = ABS ((BX*NX) + (BY*NY) + (BZ*NZ)) ;
*
*---- Coordonnees du point de tangence
XREF1 = COOR 1 PTG ;
YREF1 = COOR 2 PTG ;
ZREF1 = COOR 3 PTG ;
*
*---- Centre du plasma au dessus du point de tangence
XCREF1 = XREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
YCREF1 = YREF1 * GRP1 / ((XREF1**2 + (YREF1**2))**0.5);
*
*---- DREF1 est le petit rayon du plasma
DREF1 = (((XREF1-XCREF1)**2) + ((YREF1-YCREF1)**2) + (ZREF1**2))**.5;
DIST1 = (((XP1 - XCP1)**2) + ((YP1 - YCP1)**2) + (ZP1**2))**.5;
*
*---- Distance a la DSMF
LDEC1 = DIST1 - DREF1 ;
*
*---- Calcul du profil de flux
VPAT1 = COS_BN * (EXP (LDEC1/(-1.*LAMBQ))) ;
VFP1 = FLUX MODEL0 VPAT1 ;
*
*---- Visualisations
ARET0 = ARETE LPAT1 ;
TITRE '@FLUXTOT : B.N = COSINUS OF THE INCIDENCE ANGLE';
TRAC OEIL0 COS_BN LPAT1 ARET0;
TITRE '@FLUXTOT : TANGENT VECTOR TO THE MAGNETIC LINE';
VB = @CVECT BX BY BZ LPAT1 VERT;
TRAC OEIL0 VB LPAT1 ;
TITRE '@FLUXTOT : DISTANCE TO THE LCFS' ;
TRAC OEIL0 LDEC1 LPAT1 ARET0;
TITRE '@FLUXTOT : PROFILE OF THE INCIDENT FLUX' ;
TRAC OEIL0 VPAT1 LPAT1 ARET0;
*
*-------------------- VARIABLES EN SORTIE
*---- flux moyen et puissance
TAB1.V_SOM1 = (EXTR LISFLU (DIME LISFLU)) * (MAXI (RESU VFP1));
TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;
*-----------------------------------------
*
MESS '---------------------------------> exiting @FLUXTOT';
FINPROC VPAT1 ;

**** @FLUXX
DEBPROC @FLUXX TAB1*TABLE;
*----------------------------------------------------------------------
* Procedure de calcul de flux incident dans differents cas de geometrie
*
* TAB1.DEPOT_FLUX = MOT 'CANON'         : CANON A ELECTRON      @FLUXH
*                   MOT 'PLASMAFLUX_2D' : PLASMA ou flux  2D    @FLUXQP
*                   MOT 'PLASMA_3D'     : PLASMA, 3D            @FLUXTOT
*                   MOT 'FLUX_3D'       : FLUX 3D directions // @FLUX_3D
*                   MOT 'RIPPLE_SHIFT'  : 2D ou 3D avec         @TOKAFLU
*                                         RIPPLE et SHIFT
*                                         de SHAFRANOV
*
*'PLASMAFLUX_2D' regroupe en fait 3 cas :
*                    plasma en coupe poloidale (petit cercle)
*                    plasma en coupe toroidale (bande)
*                    plasma modelise par des lignes //
*js 26/3/96
*js TAB1.LIS_FLUX est une des entrees il faudrait pour plus de clarte
*js  TAB1.LIS_FLUXM  cas du canon a electron
*js  TAB1.LIS_FLUX =  TAB1.LIS_PHI0 cas des PLASMAS
*js
*js
*js il sort de la procedure
*js
*js TAB1.'VFPAT1'.INT1 chpoint du chargement total
*js
*js TAB1.'LIS_FLUMOYEN' liste des flux moyens en principe au sens de
*js  la   MESU TAB1.LFLUX_EXTE (mais ce qui n'est pas bon c'est que parfois
*js  c'est pris sur la largeur de srape off layer intercepte
*js
*js
*js TAB1.'LIS_PUI1' c'est en principe TAB1.'LIS_FLUMOYEN'
*(MESUTAB1.LFLUX_EXTE)
*js
*js il faudrait tjs faire dans cette procedure
*js
*js  FPAT1 =      FLUX  (TAB1 . 'MODELF') TAB1.'VFPAT1'.INT1   ;
*js  TAB1.'LIS_PUI1' = TAB1.'LIS_PUI1' ET PROG ((RESU FPAT1))  ;
*js  TAB1.'LIS_FLUMOYEN' =  TAB1.'LIS_PUI1' /(MESU TAB1.LFLUX_EXTE);
*js
*js  une fois ces changements faits proprement
*js
*js  attention aux modif dans TPERM (facile) PPERM
*js (complexe mais ca devrait eclaicir)
*js                         et TTRANS        PTRANS
*js                         et dans les procedures appelees par FLUXX
*js  une fois ces modifs faites il est facile de rajouter un flux additionnel
*js         TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1 + TAB1.FLUX_ADDITIONNEL
*js
*js
*js
*MESS 'JS 220296 Attention il faut maintenant concatener';
*MESS 'cat fluxx.procedur fluxh.procedur fluxqp.procedur' ;
*MESS '    fluxtot.procedur flux_3d.procedur > fluxx.bidon' ;
*MESS 'et utiliser fluxx.bidon  a la place de fluxx.procedur';
*MESS 'en cas de pb l ancienne procedure est disponible dans';
*MESS '                    ~schlos/fluxx.procedur.220296.old';
*
MESS ' ';
*
* --- entrees
*
NIVEAU = TAB1.'NIVEAU';
SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> calling @FLUXX';
FINSI ;

***************
* ON TESTE SI IL Y A UN FLUX OU DEUX FLUX A SUPERPOSER.
SI (EXISTE TAB1 LIS_FLUXP);
  SI (EGA (DIME TAB1.LIS_FLUX) (DIME TAB1.LIS_FLUXP));
    BOOL1 = VRAI;
    TMP = TABLE;
  SINON;
    ERRE 'TAB1.LIS_FLUX et TAB1.LIS_FLUXP ne sont pas de meme longueur';
  FINSI;
SINON;
  BOOL1 = FAUX;
FINSI;

************
* CONSTRUCTION DE VPAT1 : PROFIL DU FLUX INCIDENT
*
SI (EXISTE TAB1 DEPOT_FLUX);
   IVERIF = 0 ;
   SI (EGA TAB1.DEPOT_FLUX 'CANON');
      VPAT1 = @FLUXH TAB1;
      IVERIF = 1 ;
   FINSI ;
   SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
      VPAT1 = @FLUXQP TAB1;
      IVERIF = 1 ;
      SI BOOL1;
         TMP = TAB1.LIS_FLUX;
         TAB1.LIS_FLUX = TAB1.LIS_FLUXP;
         VPAT2 = @FLUXH TAB1;
         TAB1.LIS_FLUX = TMP;
      FINSI;
   FINSI ;
   SI (EGA TAB1.DEPOT_FLUX 'FLUX_3D');
      VPAT1 = @FLUX_3D TAB1;
      IVERIF = 1 ;
   FINSI ;
   SI (EGA TAB1.DEPOT_FLUX 'PLASMA_3D');
      VPAT1 = @FLUXTOT TAB1;
      VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
      IVERIF = 1 ;
   FINSI ;
   SI (EGA TAB1.DEPOT_FLUX 'RIPPLE_SHIFT');
      VPAT1 = @TOKAFLU TAB1;
      SI (EXISTE TAB1 <PENETRATION) ;

         SI (TAB1.<PENETRATION) ;
*           ---- Prise en compte de la penetration
            PROFPEN0 = @TOKAPEN TAB1;
             VPAT1 = VPAT1 + PROFPEN0 ;
         FINSI;
      FINSI;
      VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
      SI (EXISTE TAB1 <PUISSANCE_EXTRAITE) ;
         TAB1.LIS_FLUX = TAB1.<PUISSANCE_EXTRAITE/(MAXI(RESU VFP1));
      FINSI ;
      VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
*     ---- pourquoi ne prendre que la derniere valeur de TAB1.LIS_FLUX
      TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX))
                      * (MAXI (RESU VFP1));
      IVERIF = 1 ;
   FINSI ;
   SI (IVERIF EGA 0) ;
      ERRE ' FLUXX : VERIFIER LA VALEUR DE TAB1.DEPOT_FLUX';
   FINSI ;
SINON ;
   ERRE ' FLUXX : PRECISEZ LA VALEUR TAB1.DEPOT_FLUX';
FINSI ;
TAB1.V_VPAT1 = VPAT1;

***********
* CONSTRUCTION DE VFPAT1 : FLUX INCIDENT
*
TAB1.'VFPAT1' = TABLE;
DIME1 = DIME TAB1.LIS_FLUX;
INT1 = 0;
REPETER BOUC1 DIME1;
  INT1 = INT1 + 1;
  TAB1.'VFPAT1'.INT1 = (VPAT1 * (EXTR TAB1.LIS_FLUX INT1));
FIN BOUC1;
* AJOUT DU SECOND FLUX SI BESOIN
SI BOOL1;
   INT1 = 0;
   REPETER BOUC2 DIME1;
      INT1 = INT1 + 1;
      TAB1.'VFPAT1'.INT1 = TAB1.'VFPAT1'.INT1
                           + (VPAT2 * (EXTR TAB1.LIS_FLUXP INT1));
   FIN BOUC2;
FINSI;

***********************************
* PRISE EN COMPTE DE LA PENETRATION
SI ((NEG TAB1.DEPOT_FLUX 'CANON') ET (EXISTE TAB1 PENETRATION));
   @CALPENE TAB1;
FINSI;


*****************************************
* CALCUL DE LA PUISSANCE ET DU FLUX MOYEN

SI (TAB1.PERMANENT);
   INT2 = 0;
SINON;
   SI (TAB1.TRANSITOIRE);
      INT2 = (DIME TAB1.LIS_FLUX) - 1;
   SINON;
      ERRE 'IL FAUT CHOISIR PERMANENT OU TRANSITOIRE';
   FINSI;
FINSI;
   SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
      SI BOOL1;
         TAB1.'LIS_FLUMOYEN' =  TAB1.LIS_FLUXP * TAB1.V_FACFM1;
      SINON;
         TAB1.'LIS_FLUMOYEN' =  TAB1.LIS_FLUX * TAB1.V_FACFM1;
      FINSI;
      TAB1.'LIS_PUI1'  = TAB1.'LIS_FLUMOYEN' * TAB1.L_HEATED
                                         * TAB1.WE_HEATED_N;
   FINSI;
   SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
       TAB1.'LIS_FLUMOYEN' = TAB1.LIS_FLUX * TAB1.V_FACFM2;
      SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
         SI (EXISTE TAB1 CENTRE_PLASMA);
            TAB1.'LIS_PUI1' = TAB1.'LIS_FLUMOYEN'
                                   * TAB1.B_HEATED * TAB1.WE_HEATED_R;
         SINON;
           TAB1.'LIS_PUI1' =  TAB1.'LIS_FLUMOYEN'
                                   * TAB1.L_HEATED * TAB1.WE_HEATED_R;
         FINSI;
         SI (EXISTE TAB1 PENETRATION);
            TAB1.'LIS_PUI1' = TAB1.LIS_PUIPENE * TAB1.L_HEATED;
         FINSI;
      SINON;
        SI ((VALE DIME) EGA 3);
         TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN' * (MESU TAB1.LFLUX_EXTE);
        SINON ;
         SI ( EXISTE TAB1 B_HEATED) ;
          TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN'
              * (MESU TAB1.LFLUX_EXTE)* (TAB1.B_HEATED);
         SINON ;
          TAB1.'LIS_PUI1'= TAB1.'LIS_FLUMOYEN'
              * (MESU TAB1.LFLUX_EXTE)* (TAB1.L_HEATED);
         FINSI ;
        FINSI ;
      FINSI;
   FINSI;

*jsTAB1.'FLU1' = TABLE;
*jsTAB1.'PUI1' = TABLE;
*jsNB1 = (DIME TAB1.LIS_FLUX) - INT2;
*jsREPETER BOUC3 NB1;
*js   INT2 = INT2 + 1;
*js   TAB1.'PUI1'.INT2 = 0.;
*js   SI ((EGA TAB1.DEPOT_FLUX 'CANON') OU BOOL1);
*js      SI BOOL1;
*js         FLU1 = (EXTR TAB1.LIS_FLUXP INT2) * TAB1.V_FACFM1;
*js      SINON;
*js         FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM1;
*js      FINSI;
*js      TAB1.'FLU1'.INT2 = FLU1;
*js      TAB1.'PUI1'.INT2 = FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_N;
*js   FINSI;
*js   SI (NON (EGA TAB1.DEPOT_FLUX 'CANON'));
*js      FLU1 = (EXTR TAB1.LIS_FLUX INT2) * TAB1.V_FACFM2;
*js      TAB1.'FLU1'.INT2 = FLU1;
*js     SI (EGA TAB1.DEPOT_FLUX 'PLASMAFLUX_2D');
*js         SI (EXISTE TAB1 CENTRE_PLASMA);
*js            TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
*js                            + (FLU1 * TAB1.B_HEATED * TAB1.WE_HEATED_R);
*js         SINON;
*js            TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
*js                            + (FLU1 * TAB1.L_HEATED * TAB1.WE_HEATED_R);
*js         FINSI;
*js         SI (EXISTE TAB1 PENETRATION);
*js            TAB1.'PUI1'.INT2 = TAB1.'PUI1'.INT2
*js                                  + (TAB1.PUIPENE.INT2 * TAB1.L_HEATED);
*js         FINSI;
*js      SINON;
*js        TAB1.'PUI1'.INT2 = FLU1 * (MESU TAB1.LFLUX_EXTE);
*js      FINSI;
*js   FINSI;
*jsFIN BOUC3;
SI (NIVEAU >EG 4) ;
 MESS '--------------------------> exiting @FLUXX';
FINSI ;
MESS '>>>FLUXX>> FLU_MOYEN ET PUI1';
list TAB1.'LIS_FLUMOYEN';
list TAB1.'LIS_PUI1';
FINPROC;


**** @FLUX_3D
*--------------------------------------------------------------------
*  Procedure @FLUX_3D
*--------------------------------------------------------------------
DEBPROC @FLUX_3D TAB1*TABLE;
MESS '---------------------------------> calling @FLUX_3D';
*
****** ATTENTION --> Cette procedure ne tourne qu'en 3D

S_TOT1 = TAB1.M_ILLAGE_TOT ;
LPAT1 = TAB1.LFLUX_EXTE ;
COSDIR1 COSDIR2 COSDIR3 = @VNORM3D
(EXTR TAB1.'MODELF' 'MAIL') LPAT1 TAB1.'NIVEAU';

SI ((EXISTE TAB1 VAL_ANGLEI1) ET (EXISTE TAB1 VAL_ANGLEI2));
   SI (EXISTE TAB1 CENTRE_PLASMA);
      ERREUR 'ON NE PEUT PAS AVOIR ANGLEI1 ET LE CENTRE DU PLASMA';
   FINSI;
SINON;
   ERR 'CAS NON PREVU POUR L INSTANT';
FINSI;

*
* CALCUL DES DISTANCES AU POINT DE TANGENCE
*******************************************
COSP1 = (COS TAB1.VAL_ANGLEI1) * (COS TAB1.VAL_ANGLEI2);
COSP2 = (COS TAB1.VAL_ANGLEI1) * (SIN TAB1.VAL_ANGLEI2);
COSP3 = SIN TAB1.VAL_ANGLEI1;
XPTG = COOR 1 TAB1.PT_TGPLASMA;
YPTG = COOR 2 TAB1.PT_TGPLASMA;
ZPTG = COOR 3 TAB1.PT_TGPLASMA;
XP1 = COOR 1 LPAT1;
YP1 = COOR 2 LPAT1;
ZP1 = COOR 3 LPAT1;
A1 = (COSP1*(XPTG - XP1)) + (COSP2*(YPTG - YP1)) + (COSP3*(ZPTG - ZP1));
B1 = (COSP1**2) + (COSP2**2) + (COSP3**2);
T1 = A1/B1;
XM1 = XPTG - (T1 * COSP1);
YM1 = YPTG - (T1 * COSP2);
ZM1 = ZPTG - (T1 * COSP3);

L1 = (((XM1 - XP1)**2) + ((YM1 - YP1)**2) + ((ZM1 - ZP1)**2))**.5;

*
* CALCUL DU PRODUIT SCALAIRE FLUX.NORMALE
*****************************************
VN1  = ( EXCO 'SCAL' COSDIR1 'UX' ) + ( EXCO 'SCAL' COSDIR2 'UY' )
                                    + ( EXCO 'SCAL' COSDIR3 'UZ' ) ;
DFL1 = MANU CHPO LPAT1 3 'FX' COSP1 'FY' COSP2 'FZ' COSP3;
SIN1 = ABS (PSCA VN1 DFL1 (MOTS 'UX' 'UY' 'UZ') (MOTS 'FX' 'FY' 'FZ'));


VPAT1 = EXP (-1.*L1/TAB1.LAMDAQ) * SIN1;

TRAC QUAL (-1.E3 -1.E3 1.E3) VPAT1 LPAT1;
TRAC QUAL (1.E3 -1000. 1.E3) VPAT1 LPAT1;

*
* CALCUL DU FLUX MOYEN ET DE LA PUISSANCE
*****************************************
VFP1 = FLUX TAB1.'MODELF' VPAT1 ;
TAB1.V_SOM1 = (EXTR TAB1.LIS_FLUX (DIME TAB1.LIS_FLUX))
                                                   * (MAXI (RESU VFP1));
TAB1.V_FACFM2 = (MAXI (RESU VFP1)) / (MESU LPAT1) ;


MESS '---------------------------------> Sortie  de  @FLUX_3D';
FINPROC VPAT1;

**** @FRENET
*****************************************************************
*   PROCEDURE FRENET : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
*****************************************************************
DEBPROC @FRENET GEO*MAILLAGE MOT1/MOT OEIL1/POINT;
LOG1 = EXISTE MOT1;
GEO1 = CHAN SEG2 GEO ;
DIMGEO = VALEUR DIME ;
SI (DIMGEO > 2);
 NEL = NBEL GEO1 ;
 NP = NBNO GEO1 ;
 IP = 1 ;
 REPETER BOUC1 (NEL - 1) ;
 IP = IP + 1 ;
* mess 'ip =' ip ;
 EIP1 = GEO1 ELEM (IP - 1 )  ;
 PI1  = EIP1 POIN INITIAL  ;
 EIP2 = GEO1 ELEM IP ;
 PIP = EIP2 POIN INITIAL ;
 PI2 = EIP2 POIN FINAL   ;
 LII = EIP1 ET EIP2                         ;
 V1 = MOIN PI1 PIP ;
 V2 = MOIN PIP PI2 ;
 V4 = V1 PVEC V2 ;
 SI ((NORM V4) < ((NORM V1) * 1.E-5));
  SI (IP < NEL);
   INCR = IP;
   REPETER BOUC2 ;
    INCR = INCR + 1 ;
*    MESS ' INCR =  ' INCR;
    ELE1 = GEO1 ELEM INCR ;
    PT2 = ELE1 POIN FINAL ;
    V22 = MOIN PIP PT2 ;
    V42 = V1 PVEC V22 ;
    SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
     QUITTER BOUC2 ;
    FINSI ;
    SI (INCR EGA NEL) ;
     V42 = V1 PVEC (1. 0. 0.) ;
     SI ((NORM V42) > ((NORM V1) * 1.E-5)) ;
*      MESS 'PERPENDICULAIRE A L AXE X';
      QUITTER BOUC2 ;
     SINON ;
      V42 = V1 PVEC (0. -1. 0.) ;
*      MESS 'PERPENDICULAIRE A L AXE Y';
      QUITTER BOUC2 ;
     FINSI ;
    FINSI ;
   FIN BOUC2 ;
   V4 = V42 ;
  SINON ;
*   MESS ' DERNIER VECTEUR ';
   V4 = BPI;
  FINSI;
 FINSI;
 NV4 = NORM V4               ;
 BPI = V4 * ( 1. / NV4 ) ;
 CHBI = MANU CHPO PIP 3 'BX' (COOR 1 BPI)
                        'BY' (COOR 2 BPI)
                        'BZ' (COOR 3 BPI) NATURE DIFFUS;
 V4 = BPI PVEC V1 ;
 V5 = BPI PVEC V2 ;
 V6 = V4 PLUS V5 ;
 NPI = -1. * (V6/(NORM V6)) ;
 CHNI = MANU CHPO PIP 3 'NX' (COOR 1 NPI)
                        'NY' (COOR 2 NPI)
                        'NZ' (COOR 3 NPI) NATURE DIFFUS;
 TPI = NPI PVEC BPI ;
 CHTI = MANU CHPO PIP 3 'TX' (COOR 1 TPI)
                        'TY' (COOR 2 TPI)
                        'TZ' (COOR 3 TPI) NATURE DIFFUS;
 SI (EGA IP 2) ;
  CHB = CHBI ;
  CHN = CHNI ;
  CHT = CHTI ;
 SINON ;
  CHB = CHB ET CHBI ;
  CHN = CHN ET CHNI ;
  CHT = CHT ET CHTI ;
 FINSI ;
 FIN BOUC1 ;
* MESS 'ELEMENT N0 1' ;
 EI1 = GEO1 ELEM 1 ;
 PI1 = EI1 POIN INITIAL ;
 P2 = EI1 POIN FINAL ;
 EL2 = GEO1 ELEM 2 ;
 EL3 = GEO1 ELEM 3 ;
 EL4 = GEO1 ELEM 4 ;
 CHT2 = REDU CHT EL2 ;
 CHT3 = REDU CHT EL3 ;
 CHT4 = REDU CHT EL4 ;
 CHN2 = REDU CHN EL2 ;
 CHN3 = REDU CHN EL3 ;
 CHN4 = REDU CHN EL4 ;
 CHB2 = REDU CHB EL2 ;
 CHB3 = REDU CHB EL3 ;
 CHB4 = REDU CHB EL4 ;
 DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
 DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
 DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
 DS1 = NORM (MOIN PI1 P2) ;
 RAP12 = (DS1+DS2)/2;
 RAP23 = (DS2+DS3)/2;
 RAP34 = (DS3+DS4)/2;
 PR2 = (R3-R2)/RAP23;
 PR3 = (R4-R3)/RAP34;
 PT2 = (T3-T2)/RAP23;
 PT3 = (T4-T3)/RAP34;
 RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
 PR1 = PR2+((PR2-PR3)*RAP);
 R1 = R2-(PR1*RAP12);
 ALPHA1 = -1. * (DS1/R1)* (180. / PI);
 SI (T2 > 1.E98);
  BETA1 = 0. ;
 FINSI ;
 SI (T3 > 1.E98) ;
  SI (T2 > 1.E98);
   BETA1 = 0. ;
  SINON ;
   TT1 = (1./T2)*(1. + RAP) ;
   T1 = 1./TT1 ;
   BETA1 = (DS1/T1)*180/PI;
  FINSI ;
 FINSI ;
 SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  PT1 = PT2+((PT2-PT3)*RAP);
  T1 = T2-(PT1*RAP12);
  BETA1 = (DS1/T1)*180./PI ;
 FINSI ;
 NXI2 = EXTR CHN NX P2 ;
 NYI2 = EXTR CHN NY P2 ;
 NZI2 = EXTR CHN NZ P2 ;
 VN2 = NXI2 NYI2 NZI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 TZI2 = EXTR CHT TZ P2 ;
 VT2 = TXI2 TYI2 TZI2 ;
 BXI2 = EXTR CHB BX P2 ;
 BYI2 = EXTR CHB BY P2 ;
 BZI2 = EXTR CHB BZ P2 ;
 VB2 = BXI2 BYI2 BZI2 ;
 VN = (VN2 * (COS BETA1)) PLUS (VB2 * (SIN BETA1)) ;
 VB1 = (VN2 * (-1.*(SIN BETA1))) PLUS (VB2 * (COS BETA1)) ;
 VT1 = (VT2 * (COS ALPHA1)) PLUS (VN * (SIN ALPHA1)) ;
 VN1 = (VT2 * (-1.*(SIN ALPHA1))) PLUS (VN * (COS ALPHA1)) ;
 CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1)
                        'TY' (COOR 2 VT1)
                        'TZ' (COOR 3 VT1)  NATURE DIFFUS;
 CHT = CHT ET CHTI ;
 CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1)
                        'NY' (COOR 2 VN1)
                        'NZ' (COOR 3 VN1)  NATURE DIFFUS;
 CHN = CHN ET CHNI ;
 CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1)
                        'BY' (COOR 2 VB1)
                        'BZ' (COOR 3 VB1)  NATURE DIFFUS;
 CHB = CHB ET CHBI ;
* MESS 'ELEMENT N0 NEL' ;
 EI1 = GEO1 ELEM NEL ;
 PI1 = EI1 POIN FINAL ;
 P2 = EI1 POIN INITIAL ;
 EL2 = GEO1 ELEM (NEL-1) ;
 EL3 = GEO1 ELEM (NEL-2) ;
 EL4 = GEO1 ELEM (NEL-3) ;
 CHT2 = REDU CHT EL2 ;
 CHT3 = REDU CHT EL3 ;
 CHT4 = REDU CHT EL4 ;
 CHN2 = REDU CHN EL2 ;
 CHN3 = REDU CHN EL3 ;
 CHN4 = REDU CHN EL4 ;
 CHB2 = REDU CHB EL2 ;
 CHB3 = REDU CHB EL3 ;
 CHB4 = REDU CHB EL4 ;
 DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
 DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
 DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
 DS1 = NORM (MOIN PI1 P2) ;
 RAP12 = (DS1+DS2)/2;
 RAP23 = (DS2+DS3)/2;
 RAP34 = (DS3+DS4)/2;
 PR2 = (R3-R2)/RAP23;
 PR3 = (R4-R3)/RAP34;
 PT2 = (T3-T2)/RAP23;
 PT3 = (T4-T3)/RAP34;
 RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
 PR1 = PR2+((PR2-PR3)*RAP);
 R1 = R2-(PR1*RAP12);
 ALPHA1 = (DS1/R1)*180./PI;
 SI (T2 > 1.E98);
  BETA1 = 0. ;
 FINSI ;
 SI (T3 > 1.E98) ;
  SI (T2 > 1.E98);
   BETA1 = 0. ;
 SINON ;
   TT1 = (1./T2)*(1. + RAP) ;
   T1 = 1./TT1 ;
   BETA1 = -1.*(DS1/T1)*180/PI;
  FINSI ;
 FINSI ;
 SI ((T2 < 1.E98) ET (T3 < 1.E98)) ;
  PT1 = PT2+((PT2-PT3)*RAP);
  T1 = T2-(PT1*RAP12);
  BETA1 = -1.*(DS1/T1)*180/PI ;
 FINSI ;
 NXI2 = EXTR CHN NX P2 ;
 NYI2 = EXTR CHN NY P2 ;
 NZI2 = EXTR CHN NZ P2 ;
 VN2 = NXI2 NYI2 NZI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 TZI2 = EXTR CHT TZ P2 ;
 VT2 = TXI2 TYI2 TZI2 ;
 BXI2 = EXTR CHB BX P2 ;
 BYI2 = EXTR CHB BY P2 ;
 BZI2 = EXTR CHB BZ P2 ;
 VB2 = BXI2 BYI2 BZI2 ;
 VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
 VN = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
 VB = VB2 ;
 VN1 = (VN * (COS BETA1)) PLUS (VB * (SIN BETA1)) ;
 VB1 = (VN * (-1. * (SIN BETA1))) PLUS (VB * (COS BETA1)) ;
 CHTI = MANU CHPO PI1 3 'TX' (COOR 1 VT1)
                        'TY' (COOR 2 VT1)
                        'TZ' (COOR 3 VT1) NATURE DIFFUS;
 CHT = CHT ET CHTI ;
 CHNI = MANU CHPO PI1 3 'NX' (COOR 1 VN1)
                   'NY' (COOR 2 VN1)
                    'NZ' (COOR 3 VN1) NATURE DIFFUS;
 CHN = CHN ET CHNI ;
 CHBI = MANU CHPO PI1 3 'BX' (COOR 1 VB1)
                        'BY' (COOR 2 VB1)
                        'BZ' (COOR 3 VB1) NATURE DIFFUS;
 CHB = CHB ET CHBI ;
 COX COY COZ = COOR GEO ;
 XMAX = MAXI COX ;
 YMAX = MAXI COY ;
 ZMAX = MAXI COZ ;
 XMIN = MINI COX ;
 YMIN = MINI COY ;
 ZMIN = MINI COZ ;
 DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2) +
      ((ZMAX -ZMIN)**2))**0.5 ;
 AMP = DL/10. ;
 VT = VECT CHT AMP TX TY TZ ROUGE ;
 VN = VECT CHN AMP NX NY NZ VERT ;
 VB = VECT CHB AMP BX BY BZ JAUNE ;
 SI (LOG1 EGA VRAI);
  TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  TRAC OEIL1 QUAL (VT ET VN ET VB) GEO1 ;
 FINSI;
SINON ;
 NEL = NBEL GEO1;
 NP = NBNO GEO1;
 O = 0. 0.;
 IP = 1;
 REPETER BOUC2 (NEL - 1);
  IP =IP+1;
*  MESS ' IP = ' IP;
  EIP1 = GEO1 ELEM (IP-1);
  PI1  = EIP1 POIN INITIAL  ;
  EIP2 = GEO1 ELEM IP ;
  PIP = EIP2 POIN INITIAL ;
  PI2 = EIP2 POIN FINAL   ;
  V1 = MOIN PIP PI1;
  V2 = MOIN PI2 PIP;
  V3 = V1 TOUR 90. O;
  V4 = V2 TOUR 90. O;
  V5 = V3 PLUS V4;
  NPI = V5 / (NORM V5);
  TPI = NPI TOUR (-1*90.) O;
  CHNI = MANU CHPO PIP 2 'NX' (COOR 1 NPI)
              'NY' (COOR 2 NPI) NATURE DIFFUS;
  CHTI = MANU CHPO PIP 2 'TX' (COOR 1 TPI)
              'TY' (COOR 2 TPI) NATURE DIFFUS;
  SI (EGA IP 2) ;
   CHN = CHNI ;
   CHT = CHTI ;
  SINON ;
   CHN = CHN ET CHNI ;
   CHT = CHT ET CHTI ;
  FINSI;
  CHB = MANU CHPO GEO1 2 'BX' 0. 'BY' 0. ;
 FIN BOUC2;

* MESS 'ELEMENT N0 1' ;
 EI1 = GEO1 ELEM 1 ;
 PI1 = EI1 POIN INITIAL ;
 P2 = EI1 POIN FINAL ;
 EL2 = GEO1 ELEM 2 ;
 EL3 = GEO1 ELEM 3 ;
 EL4 = GEO1 ELEM 4 ;
 CHT2 = REDU CHT EL2 ;
 CHT3 = REDU CHT EL3 ;
 CHT4 = REDU CHT EL4 ;
 CHN2 = REDU CHN EL2 ;
 CHN3 = REDU CHN EL3 ;
 CHN4 = REDU CHN EL4 ;
 CHB2 = REDU CHB EL2 ;
 CHB3 = REDU CHB EL3 ;
 CHB4 = REDU CHB EL4 ;
 DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
 DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
 DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
 DS1 = NORM (MOIN PI1 P2) ;
 RAP12 = (DS1+DS2)/2;
 RAP23 = (DS2+DS3)/2;
 RAP34 = (DS3+DS4)/2;
 PR2 = (R3-R2)/RAP23;
 PR3 = (R4-R3)/RAP34;
 RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
 PR1 = PR2+((PR2-PR3)*RAP);
 R1 = R2-(PR1*RAP12);
 ALPHA1 = -1. * (DS1/R1)* (180. / PI);
 NXI2 = EXTR CHN NX P2 ;
 NYI2 = EXTR CHN NY P2 ;
 VN2 = NXI2 NYI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 VT2 = TXI2 TYI2 ;
 BXI2 = EXTR CHB BX P2 ;
 BYI2 = EXTR CHB BY P2 ;
 VB2 = BXI2 BYI2 ;
 VT1 = (VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1)) ;
 VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
 VB = VB2 ;
 CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1)
        'TY' (COOR 2 VT1) NATURE DIFFUS;
 CHT = CHT ET CHTI ;
 CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1)
       'NY' (COOR 2 VN1)  NATURE DIFFUS;
 CHN = CHN ET CHNI ;

* MESS 'ELEMENT N0 NEL' ;
 EI1 = GEO1 ELEM NEL ;
 PI1 = EI1 POIN FINAL ;
 P2 = EI1 POIN INITIAL ;

 EL2 = GEO1 ELEM (NEL-1) ;
 EL3 = GEO1 ELEM (NEL-2) ;
 EL4 = GEO1 ELEM (NEL-3) ;
 CHT2 = REDU CHT EL2 ;
 CHT3 = REDU CHT EL3 ;
 CHT4 = REDU CHT EL4 ;
 CHN2 = REDU CHN EL2 ;
 CHN3 = REDU CHN EL3 ;
 CHN4 = REDU CHN EL4 ;
 CHB2 = REDU CHB EL2 ;
 CHB3 = REDU CHB EL3 ;
 CHB4 = REDU CHB EL4 ;
 DS2 R2 T2 ALPHA2 BETA2 = @COUTOR1 EL2 CHT2 CHN2 CHB2 ;
 DS3 R3 T3 ALPHA3 BETA3 = @COUTOR1 EL3 CHT3 CHN3 CHB3 ;
 DS4 R4 T4 ALPHA4 BETA4 = @COUTOR1 EL4 CHT4 CHN4 CHB4 ;
 DS1 = NORM (MOIN PI1 P2) ;
 RAP12 = (DS1+DS2)/2;
 RAP23 = (DS2+DS3)/2;
 RAP34 = (DS3+DS4)/2;
 PR2 = (R3-R2)/RAP23;
 PR3 = (R4-R3)/RAP34;
 RAP = (DS1+(2*DS2)+DS3)/(DS2+(2*DS3)+DS4);
 PR1 = PR2+((PR2-PR3)*RAP);
 R1 = R2-(PR1*RAP12);
 ALPHA1 = (DS1/R1)*180./PI;
 NXI2 = EXTR CHN NX P2 ;
 NYI2 = EXTR CHN NY P2 ;
 VN2 = NXI2 NYI2 ;
 TXI2 = EXTR CHT TX P2 ;
 TYI2 = EXTR CHT TY P2 ;
 VT2 = TXI2 TYI2 ;
 VT1 = ((VT2 * (COS ALPHA1)) PLUS (VN2 * (SIN ALPHA1))) ;
 VN1 = (VT2 * (-1. * (SIN ALPHA1))) PLUS (VN2 * (COS ALPHA1)) ;
 CHTI = MANU CHPO PI1 2 'TX' (COOR 1 VT1)
 'TY' (COOR 2 VT1) NATURE DIFFUS;
 CHT = CHT ET CHTI ;
 CHNI = MANU CHPO PI1 2 'NX' (COOR 1 VN1)
  'NY' (COOR 2 VN1) NATURE DIFFUS;
 CHN = CHN ET CHNI ;

 COX COY = COOR GEO ;
 XMAX = MAXI COX ;
 YMAX = MAXI COY ;
 XMIN = MINI COX ;
 YMIN = MINI COY ;
 DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
 AMP = DL/10. ;
 VT = VECT CHT AMP TX TY ROUGE ;
 VN = VECT CHN AMP NX NY VERT ;
 SI (LOG1 EGA VRAI);
  TITRE 'REPERE DE FRENET DE LA LIGNE' ;
  TRAC QUAL (VN ET VT) GEO1;
 FINSI;
FINSI ;
FINPROC CHT CHN CHB ;
**** @FRENETT
'DEBPROC' @FRENETT       LIGN_1*MAILLAGE      ;
MESS '----------------------> entree dans @FRENETT ';
  V1 = VALEUR DIME             ;
  SI( V1 EGA 2 )               ;
*   CHT CHN CHB  = @FRENET  LIGN_1 'TRACE' ;
   CHT CHN CHB  = @FRENET  LIGN_1  ;
   CHPP = CHT ET CHN ;
  SINON ;
*   CHT CHN CHB  = @FRENET  LIGN_1 'TRACE' (0. 0. 1000.);
   CHT CHN CHB  = @FRENET  LIGN_1  ;
   CHPP = CHT ET CHN ET CHB     ;
  FINSI  ;
MESS '----------------------> sortie  de  @FRENETT ';
'FINPROC'  CHPP;
**** FROTTER
*---------------------------------------------------------------------
*             PROCEDURE FROTTER   VERSION DU 15/11/87
*             MODIFICATION RECUE LE 22/09/1992
*---------------------------------------------------------------------
*   CETTE PROCEDURE SERT A CALCULER LE CONTACT AVEC FROTTEMENT
*
*   SYNTAXE :
*   -------
*
*
*   SOL  RE  =  FROTTER  RIG  FOR  BLOCAG  COEF ;
*
*        RIG    : LA RIGIDITE AVEC SES BLOCAGES AUTRES QUE UNILATERAUX
*                 ET DE FROTTEMENT
*        FOR    : LE VECTEUR SECOND MEMBRE
*        BLOCAG : LES BLOCAGES UNILATERAUX ET DE FROTTEMENT
*        COEF   : LES COEFFICIENTS DE FROTTEMENT
*
*  EN SORTIE :    DE    : LA SOLUTION
*                 RE    : LES REACTIONS D'APPUIS
*                 RIAD
*
*---------------------------------------------------------------------
*
      DEBPROC FROTTER  ZR*RIGIDITE  FFF*CHPOINT  BBN*RIGIDITE
   BBT*RIGIDITE ZCOEF*CHPOINT  ZEZE*MAILLAGE IPAPA*ENTIER;
*
*----------------------------------------------------------------------
*
*--------------------
*  INITIALISATIONS
*--------------------
*
MAXIT = 10 ;
*-----------------------  MILL 16 / 4 /92
*ZPREC1 = 1.E-8;
*ZPREC2 = 1.E-4 ;
ZPREC1 = 1.E-10;
ZPREC2 = 1.E-8 ;
*-----------------------
GEOT= EXTRAI BBT MAIL MULT ;
BBB = BBN ET BBT ;
*MESS ' LES NOEUDS ASSOCIES A BBN ' ;NOBBN =EXTRAI BBN MAIL MULT   ;
*LIST NOBBN;
*MESS ' LES NOEUDS ASSOCIES A BBT ' ;NOBBT =EXTRAI BBT MAIL MULT   ;
*LIST NOBBT;
SSDIM = VALEUR DIME ;
SI ( EGA SSDIM 3 ) ;
OEIL = -1000 -1500 20000 ;
FINSI ;
*
*------------------------------
*   CALCUL DU SUPER ELEMENT
*------------------------------
*
   SUP = SUPER RIGI ZR BBB ;
   STAT = VRAI ;
   RISUP = EXTRAI SUP RIGI;
FFF0= DEPIMP BBB 0.; FA = FFF ET FFF0;
*MESS ' VECTEUR FFF EN ENTREE DE FROTTER ' ;
*LIST FFF ;
   F = SUPER  CHAR SUP  FA ;
*MESS ' VECTEUR F SORTI DE SUPER ' ; LIST F ;

    DETR FFF0  GEOM ;
*
*-----------------------
*   INITIALISATIONS
*-----------------------
*
    ITER = 0 ;
    NCONV = VRAI ;
    FROT = MANU CHPO GEOT 2 FX 0. FY 0. ;
    DE   = MANU CHPO GEOT 2 UX 0. UY 0. ;
      DEPTOT = FA  EXCO FLX  FLX ;
*MESS ' DEPTOT ' ; LIST DEPTOT ;
      FDEPTO = F ET DEPTOT ;
*MESS ' VOICI FDEPTO ' ; LIST FDEPTO ;
      RITOU = RISUP ET BBB ;
*  INITIALISER LISEA A UNE VALEUR IMPOSSIBLE
      LISEA = LECT -1;
      FDEPTOT=F ;
*MESS ' ON MOYENNE LES FORCES DE FROTTEMENT ' ;
*
*---------------
*  ITERATIONS
*---------------
*
SAUTER 2 LIGNE ;
   REPETER BOUCL1 MAXIT ;
   ITER = ITER + 1 ;
 MESS ' PROCEDURE FROTTER   -  ITERATION NUMERO '  ITER ;
   FPRES = FROT ;
   DRES = DE ;
*MESS ' ON ATTAQUE LA RESOLUTION ' ;
*MESS ' VOICI LES FORCES ' ; LIST FDEPTOT ;
*MESS ' VOICI LES RAIDEURS ' ; LIST RITOU ;

   DE=RESOU NOID NOUNIL RITOU FDEPTOT;

*MESS ' VOICI LA SOLUTION SORTIE DE RESOU ' ; LIST DE ;
*
*  ICI  L'ACCELERATION DE CONVERGENCE
*  ELLE SEMBLE UN PEU FOIREUSE PAR MOMENTS
*
       SI   ('MULT'  ITER  5 ) ;
*      SI   ('MULT'  ITER  30000) ;
         SI NCONVT ;
           SI LENEW;
            ZDP1= 'ACTI' 'GEOM' ZDEPN2 ZDEPN1 DE;
           'DETR' DE  ;
            DE = ZDP1 ;
         FINSI ;
       FINSI ;
 FINSI ;
  'SI' (ITER > 1 ) ;
    'SI' ( ITER > 2 ) ; 'DETR' ZDEPN2 'GEOM' ; 'FINSI';
     ZDEPN2 = ZDEPN1  ;
    'FINSI' ;
  ZDEPN1 = 'COPIER' DE 'GEOM' ;

*MESS ' LES DEPLACEMENTS ' ; LIST DE ;
*MESS ' FORCES NORMALES ' ; LIST ( REDU DE NOBBN);
*MESS ' FORCES TANGENTES' ; LIST ( REDU DE NOBBT);
*
*  PETIT DESSIN
*
 VV =VECTEUR FDEPTOT 0.1   FX FY VERT;
*DEF0=DEFOR ZEZE  DE 0 BLEU;
*DEF1=DEFOR ZEZE  DE 10 VV  ROSE;
*TRAC ( DEF0 ET DEF1 ) ;
* OPTI DONN 5 ;
*MESS ' ON APPELLE GLISSER ' ;
*MESS ' ON IMPRIME BBB   ' ; LIST BBB   ;
*OPTI IMPI 528 ;
*OPTI IMPI 530 ;
 SI ( >EG IPAPA 7);
*OPTI IMPI 530 ;
* OPTI IMPI 528 ;
 FINSI;
*BLOTO RIAD LISEN  FROTB = BBB  GLISSER  DE  DEPTOT FPRES ZCOEF  ;
 BLOTO RIAD LISEN  FROT = BBB  GLISSER  DE  DEPTOT FPRES ZCOEF  ;
 OPTI IMPI 0   ;
*MESS ' ON IMPRIME BLOTO ' ; LIST BLOTO ;
*FROT = ( FROTB + FPRES ) / 2.   ;
*MESS ' LES FORCES DE FROTTEMENT FROT ' ; LIST FROT ;
SI ( EGA SSDIM 3 )  ;

*$$ON ESSAYE DE TRACER CES FORCES
*VV1 =VECTEUR FROTB 0.1 FX FY FZ VERT;
  VV1 =VECTEUR FROT 0.1 FX FY FZ VERT;
*VV2 =VECTEUR FROT 0.1 FX FY FZ ROUG;
*VV3 =VECTEUR FPRES 0.1 FX FY FZ JAUN;
*DEF10=DEFOR ZEZE  DE 0 VV1 BLEU  ;
*DEF1=DEFOR ZEZE  DE 0 VV1 BLEU  ;
*DEF2=DEFOR ZEZE  DE 0 VV2 TURQ  ;
*DEF3=DEFOR ZEZE  DE 0 VV3 ROSE  ;
*TRAC OEIL  ( DEF1  ET DEF2 ET DEF3 )      ;
*TRAC OEIL   DEF1  ;
FINSI ;

SI ( EGA SSDIM 2 )  ;

  VV1 =VECTEUR FROT 1   FX FY    VERT;
*DEF10=DEFOR ZEZE  DE 0     BLEU  ;
*DEF1=DEFOR ZEZE  DE   VV1 TURQ  ;
*DEF2=DEFOR ZEZE  DE 0 VV2 TURQ  ;
*DEF3=DEFOR ZEZE  DE 0 VV3 ROSE  ;
*TRAC OEIL  ( DEF1  ET DEF2 ET DEF3 )      ;
*TRAC ( DEF1 ET DEF10)  ;
FINSI ;
 OPTI IMPI 0 ;
*-----------------------------
*   TESTS DE CONVERGENCE
*-----------------------------
*   D'ABORD SUR LES CONTACTS
*-----------------------------
   NCONVT = FAUX ;
   SI (LISEN EGA LISEA) ;
MESS ' ON A CONVERGE LES CONTACTS ' ;
   NCONVT = VRAI ;
   FINSI;
*-------------------------------------------------------------
*   ENSUITE SUR LES FORCES DE FROTTEMENT ET LES DEPLACEMENTS
*-------------------------------------------------------------
   SI NCONVT;
   LENEW=FAUX;
*
*   TEST SUR LES FORCES DE FROTTEMENT
*
FDIFF = FROT - FPRES ;
*MESS ' La difference sur les forces de  frottement';
*list fdiff;
DENOM= XTX FROT ;
SI ( EGA  DENOM 0. ) ;
KRIT1 = ABS ( ( XTX FDIFF ) );
SINON ;
KRIT1 = ABS ( ( XTX FDIFF ) /  DENOM  ) ;
FINSI ;
MESS ' ITERATION ' ITER  ' CRITERE 1  ' KRIT1  ;
SI ( KRIT1 < ZPREC1 ) ;
  LENEW=VRAI;
*
*  TEST SUR LES DEPLACEMENTS
*
FDIFF = DE - DRES;
FDIFF = ENLEVER  FDIFF 'LX' ;
* MESS ' La difference sur les deplacements';
*list fdiff;
DENOM= XTX DE   ;
SI ( EGA  DENOM 0. ) ;
KRIT2= ABS ( ( XTX FDIFF ) );
SINON ;
KRIT2 = ABS ( ( XTX FDIFF ) /  DENOM  ) ;
FINSI ;
MESS ' ITERATION ' ITER  ' CRITERE 2  ' KRIT2  ;
*
SI ( KRIT2 < ZPREC2) ;
NCONV = FAUX ;
DETR LISEN ;
 GFO=EXTRAI BLOTO MAIL;DETR GFO TOUT;
 DETR BLOTO ELEM  ;
QUITTER BOUCL1 ;
FINSI ;
FINSI ;
FINSI ;
*
     DETRUIRE RITOU; DETRUIRE LISEA;
     SI (ITER NEG 1);GFO=EXTRAI BLOTT MAIL;DETR GFO TOUT;
     DETR BLOTT ELEM  ;  FINSI ;
*----------------------  MILL  16/4/92
     RITOU = RISUP ET BLOTO ;
*    RITOU = RISUP ET BLOTO ET RIAD ;
*----------------------
     BLOTT= BLOTO;
     LISEA=LISEN;
*----------------------  MILL  16/4/92
*MESS ' VOICI FROT ' ; LIST FROT ;
     FDEPTOT=FDEPTO ET FROT ;
*----------------------
*
*  ON SUPPRIME LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
*  DE FROTTEMENT
*----------------------  MILL  16/4/92
*    FDEPTOT= FDEPTO - ( REDU FDEPTO GEOT ) ;
*----------------------
*  ON REMET    LA GESTION DES JEUX SUR LES NOEUDS DES BLOCAGES
*  DE FROTTEMENT MAIS EN PLUS SUBTIL
*   DU COUP CA MARCHE POUR LES INCREMENTS DE FORCE NULS,
*  MAIS CA NE MARCHERA PAS EN CAS DE DEPLACEMENT IMPOSE
*  ASSOCIE A UNE CONDITION DE BLOCAGE AVEC FROTTEMENT
*
*----------------------  MILL  18/9/92
     FDEPTOT= FDEPTOT - ( REDU DEPTOT GEOT ) ;
*----------------------
FIN BOUCL1;
*
*  ON FAIT UN PEU DE MENAGE
*
        MENAGE;
*
   SI  NCONV  ;
      MESS ' IL N Y A PAS DE SOLUTION AU SYSTEME ';
      RITOU = RISUP ET BBB ;
      LISEA = LECT 0;
   SINON;
*
MESS ' CONVERGENCE EN' ITER
 'ITERATIONS DANS LA RESOLUTION DES CONTACTS AVES FROTTEMENT ' ;
*
*-----------------------------------
*  CALCUL SUR TOUTE LA STRUCTURE
*-----------------------------------
*
RIINT = EXTRAI  SUP  RIGT ;
DP = SUPER DEPL SUP DE;
  DPFFF=DP ET FFF ET FROT ;
MESS ' RETOUR DANS TOUTE LA STRUCTURE ' ;
DE1 = RESOU  NOUNIL NOID RIINT  DPFFF ;  DE3 =DE1 EXCO LX NOID LX;
RE1= DE EXCO LX NOID LX ;  DE4 = DE3 * -1;
DE5 = QULX DE1 ZR ;
DE2=DE1 ET RE1  ET DE4 ET DE5 ;  DETR DE3; DETR DE4 GEOM;
   DETRUIRE DE1; DETRUIRE RE1 GEOM; DETRUIRE DPFFF GEOM;
                  DETRUIRE DP GEOM ; DETR DE5 GEOM;
*
*  LES REACTIONS
*
  RE2 = ( REAC RITOU DE ) ET FROT ;
*
  FINSI ;
*
DETRUIRE F  GEOM;DETRUIRE DEPTOT GEOM;DETR DE;
SI ( NEG ITER 1 )   ;
DETRUIRE FDEPTOT GEOM ;
FINSI ;
DETR FA GEOM;
*
FINPRO  DE2  RE2 FROT RIAD;




**** HELICE
******************************************************
*     PROCEDURE HELICE DE MAILLAGE EN HELICE
******************************************************
DEBPROC HELICE P1/POINT GEO1/MAILLAGE TYP1*MOT P0*POINT V0*POINT
PAS*FLOTTANT ALPHA*FLOTTANT NP*ENTIER ;
DALPHA = ALPHA / NP ;
DVT = (V0 / (NORM V0)) * (DALPHA / 360.) * PAS ;
*------------------------------------------------
*   CAS OU LA BASE EST UN POINT
*------------------------------------------------
SI (EGA TYP1 'POIN') ;
 PF1 = P1 ;
 IB = 0 ;
 REPETER BOUC1 NP ;
 IB = IB + 1 ;
 PI1 = PF1 ;
 PF1 = (PI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
 LIG1 = DROIT 1 PI1 PF1 ;
 SI (EGA IB 1) ;
  GEO3 = LIG1 ;
 SINON ;
  GEO3 = GEO3 ET LIG1 ;
 FINSI ;
 FIN BOUC1 ;
 GEO2 = PF1 ;
FINSI ;
*------------------------------------------------
*   CAS OU LA BASE EST UNE LIGNE
*------------------------------------------------
SI (EGA TYP1 'LIGN') ;
 LIGF1 = GEO1 ;
 IB = 0 ;
 REPETER BOUC2 NP ;
 IB = IB + 1 ;
 LIGI1 = LIGF1 ;
 LIGF1 = (LIGI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
* S1 = DALL1 1 LIGI1 LIGF1 ;
 S1 = LIGI1 REGLER 1 LIGF1 ;
 SI (EGA IB 1) ;
  GEO3 = S1 ;
 SINON ;
  GEO3 = GEO3 ET S1 ;
 FINSI ;
 FIN BOUC2  ;
 GEO2 = LIGF1 ;
FINSI ;
*------------------------------------------------
*   CAS OU LA BASE EST UNE SURFACE
*------------------------------------------------
SI (EGA TYP1 'SURF') ;
 SUF1 = GEO1 ;
 IB = 0 ;
 REPETER BOUC3 NP ;
 IB = IB + 1 ;
 SUI1 = SUF1 ;
 SUF1 = (SUI1 PLUS DVT) TOUR DALPHA P0 (P0 PLUS V0) ;
 V1 = SUI1 VOLU 1 SUF1 ;
 SI (EGA IB 1) ;
  GEO3 = V1 ;
 SINON ;
  GEO3 = GEO3 ET V1 ;
 FINSI ;
 FIN BOUC3  ;
 GEO2 = SUF1 ;
FINSI ;
FINPROC GEO2 GEO3;
****************************************************************
**** @IMPR
DEBPROC @IMPR PHRASE/TEXT NREEL/FLOTTANT NENTIER/ENTIER;
OPTI ECHO 0 ;
OPTI IMPR 26 ;
SI (EXISTE PHRASE);
 MESS PHRASE;
FINSI ;
SI (EXISTE NREEL );
 MESS NREEL ;
FINSI ;
SI (EXISTE NENTIER );
 MESS NENTIER;
FINSI ;
OPTI IMPR 6 ;
OPTI ECHO 1 ;
FINPROC ;
**** @INCI
DEBPROC @INCI TAB1*TABLE;
*
*****************************************************************
* PROCEDURE DE DETERMINATION DE L'ANGLE D'INCIDENCE MAX : ALPHA *
*****************************************************************
*
MESS '---------------------------------> calling @INCI';
MESS 'Calcul de l angle d incidence par le code';
*
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<V_OMBRANT_N              ;
CONT0    = TAB1.<S_OMBRANT_N              ;
TYPCAL   = TAB1.<TYPE_CALCUL         ;
*------------------------------------
*
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @INCI : check the value of TAB1.<TYPE_CALCUL';
FINSI ;
*
*
*---- coordonnees dans le repere du maillage
XM = COOR 1 CONT0 ;
YM = COOR 2 CONT0 ;
SI ((VALEUR DIME) EGA 2) ;
   ZM = XM * 0. ;
SINON ;
   ZM = COOR 3 CONT0 ;
FINSI ;
*
*---- coordonnees dans le repere global
XG YG ZG = @CRMGC XM YM ZM TAB1 ;
MENAGE ;
*
*---- calcul du champ magnetique dans le repere global
BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
MENAGE ;
*
*---- composantes de B dans le repere du maillage
BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
MENAGE ;
*
*---- calcul des normales a la surface calculees
*---- dans le repere du maillage
MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRANT';
NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
MENAGE ;
*
*---- calcul du produit scalaire et de l'angle d'incidence
B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
*
CHALPHA = ABS (90. -  ANGINCI)  ;
ALPHA = MAXI CHALPHA ;
MESS '>@INCI> Incidence maximale en degres :'ALPHA ;

MESS '---------------------------------> exiting @INCI';
FINPROC ALPHA ;
debproc @inertid geo1*maillage point1*point point2*point ;

*
* --- definition d'un modele articifiel pour les mchaml
*
mod1  = modl geo1 mecanique elastique ;
*
* --- definition des champs de coordonnees
*
chpx1 = nomc scal (coor 1 geo1) ;
chpy1 = nomc scal (coor 2 geo1) ;
*
* ---
*
chmx2 = chan cham chpx1 geo1 bidon ;
chmy2 = chan cham chpy1 geo1 bidon ;
*
* ---
*
chmx1 = chan gravite mod1 chmx2  ;
chmy1 = chan gravite mod1 chmy2 ;
*
* --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
*     de la droite passant par point1 et point2
*
x1 = coor 1 point1 ;
y1 = coor 2 point1 ;
x2 = coor 1 point2 ;
y2 = coor 2 point2 ;

si (ega x1 x2 ) ;
 si (ega y1 y2) ;
  erre '>@inertie> les deux points sont confondus';
 sinon ;
  aa1 = 1.       ;
  bb1 = 0.       ;
  cc1 = -1. * x1 ;
 finsi ;
sinon ;
 aa1 =  1./(x2 - x1);
 si (ega y1 y2) ;
  aa1 = 0.       ;
  bb1 = 1. ;
  cc1 = -1. * y1 ;
 sinon ;
  bb1 = -1./(y2 - y1);
  cc1 =  (x1 * aa1) + (x2 * bb1) * -1.;
 finsi ;
finsi ;

cc2 = manu chml mod1 scal cc1 type bidon gravite;
den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
*
* --- chmd1 est le mchaml qui contient la distance des centres
*     de gravite des elements de geo1 a la droite passant par
*     point1 et point2
*
chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
*
* --- intergration du carre du champs
*
i1 = intg mod1 (chmd1 ** 2.) ;

finproc i1 ;

debproc @inertie geo1*maillage vec1*point ;

*
* --- definition d'un modele articifiel pour les mchaml
*
mod1  = modl geo1 mecanique elastique ;
*
* --- definition des champs de coordonnees
*
chpx1 = nomc scal (coor 1 geo1) ;
chpy1 = nomc scal (coor 2 geo1) ;
*
* ---
*
chmx2 = chan cham chpx1 geo1 bidon ;
chmy2 = chan cham chpy1 geo1 bidon ;
*
* ---
*
chmx1 = chan gravite mod1 chmx2  ;
chmy1 = chan gravite mod1 chmy2 ;
*
* --- on calcule la position du centre de gravite de la section
*
ss1 = mesu geo1 ;
gx1 = (intg mod1 chmx1) / ss1  ;
gy1 = (intg mod1 chmy1) / ss1 ;



*
* --- aa1, bb1 et cc1 sont les coeffcients de l'equation cartesienne
*     de la droite passant par point1 et point2
*
x2 = coor 1 vec1 ;
y2 = coor 2 vec1 ;

aa1 = y2 ;
bb1 = -1. * x2 ;
cc1 = x2 * gx1 - (y2 * gx1) ;
cc2 = manu chml mod1 scal cc1 type bidon gravite;
den1 = ((aa1*aa1)+(bb1*bb1))**.5 ;
*
* --- chmd1 est le mchaml qui contient la distance des centres
*     de gravite des elements de geo1 a la droite passant par
*     le centre de gravite et la direction definie par le vecteur1
*
chmd1 = (abs((chmx1*aa1) + (chmy1*bb1) + cc2))/den1 ;
*
* --- intergration du carre du champs
*
i1 = intg mod1 (chmd1 ** 2.) ;

finproc (gx1 gy1) i1 ;

**** @INTERC

DEBPROC @INTERC CH_OLD2*CHPOINT
                CH_NEW2*CHPOINT
                  TOL2*FLOTTANT
                  TAB1*TABLE  ;

*MESS '---------------------------------> calling @INTERC';

S_OMBRE4  = CH_OLD2 EXTR MAIL ;
dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));

xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;

*
* +++++++++++++++++++++++++++++++++++
* RECHERCHE DES INTERCECTIONS
* +++++++++++++++++++++++++++++++++++
*
* METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
* champs par points des points remontes. Cette methode est adaptee
* a un maillage ombrant reduit et a un maillage ombre volumineux...
*

* --- CHAMP CONTENANT N POUR LES NEOUDS DE OMBRE INTERSECTES N FOIS
*CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;

S_OMBRA3 = extr tab1.<chamx1 mail ;
nel1 = nbel S_OMBRA3 ;

repe boucel1 nel1;

* mess 'facette numero' &boucel1 ;

 el1 = S_OMBRA3 elem &boucel1 ;

* on extrait les coordonnees du point A de la facette
 xa1 = extr tab1.<chamx1 scal 1 &boucel1 1 ;
 ya1 = extr tab1.<chamy1 scal 1 &boucel1 1 ;
 za1 = extr tab1.<chamz1 scal 1 &boucel1 1 ;
*
 xb1 = extr tab1.<chamx2 scal 1 &boucel1 1 ;
 yb1 = extr tab1.<chamy2 scal 1 &boucel1 1 ;
 zb1 = extr tab1.<chamz2 scal 1 &boucel1 1 ;
*
 xc1 = extr tab1.<chamx3 scal 1 &boucel1 1 ;
 yc1 = extr tab1.<chamy3 scal 1 &boucel1 1 ;
 zc1 = extr tab1.<chamz3 scal 1 &boucel1 1 ;

* on calcule les vecteurs APn et APn+1
 apnx1 = (exco X CH_OLD2) - xa1 ;
 apny1 = (exco Y CH_OLD2) - ya1 ;
 apnz1 = (exco Z CH_OLD2) - za1 ;

 apnp1x1 = (exco x CH_NEW2) - xa1 ;
 apnp1y1 = (exco y CH_NEW2) - ya1 ;
 apnp1z1 = (exco z CH_NEW2) - za1 ;

* on extrait les cosinus directeurs de la normale de la facette
 nfx1 = extr tab1.<cosx scal 1 &boucel1 1;
 nfy1 = extr tab1.<cosy scal 1 &boucel1 1;
 nfz1 = extr tab1.<cosz scal 1 &boucel1 1;

* on effectue les produits scalaires.
 ps1 = (apnx1   * nfx1) + (apny1   * nfy1) + (apnz1   * nfz1);
 ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
 pp1 = ps1*ps2 ;

* la je suis dans la facette i et je determine quels sont les segments
* PnPn+1 qui traversent le plan de la facette.
* si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
* dans le plan de la facette

* segments de part et d'autre de la facette
 mail3 = pp1 poin infe (-1.*tol2*tol2) ;
* si Pn+1 appartient au maillage ombrant
 mail6 = ps2 poin egale 0. ;
 mail7 = mail3 et mail6 ;
 n_mail7 = nbno mail7 ;
 si (ega (n_mail7) 0) ;
  iter boucel1;
 finsi ;

* mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
* le long de la ligne de champ intersecte (largement)le plan de la facette
* en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
* de la facette
* on va calculer le point d'intersection que pour ces points la.

 dex2 = redu dex4 (mail7) ;
 dey2 = redu dey4 (mail7) ;
 dez2 = redu dez4 (mail7) ;

 chr1 = redu CH_OLD2 (mail7) ;
 chr2 = redu CH_NEW2 (mail7) ;

 chrx1 = nomc scal (exco chr1 x) ;
 chry1 = nomc scal (exco chr1 y) ;
 chrz1 = nomc scal (exco chr1 z) ;


 ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
* mess 'ad1' ;(list ad1) ;
* on exclu avec une tolerence, les segments qui sont paralleles a la facette
* => on considere qu'il n'y a pas d'intersection pour ces noeuds la
 mail4 = (abs ad1) poin superieur TOL2 ;
 n_mail4 = nbno mail4 ;
* mess 'nb de segments non // a la facette'  n_mail4 ;
 si (ega n_mail4 0) ;
  iter boucel1;
 finsi ;
 ad2   = redu ad1   mail4 ;
 dex3  = redu dex2  mail4 ;
 dey3  = redu dey2  mail4 ;
 dez3  = redu dez2  mail4 ;
 chrx2 = redu chrx1 mail4 ;
 chry2 = redu chry1 mail4 ;
 chrz2 = redu chrz1 mail4 ;

 bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1)
                       - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);

 by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1)
                       - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);

 bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1)
                       - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
 xm1 = bx1 / ad2 ;
 ym1 = by1 / ad2 ;
 zm1 = bz1 / ad2 ;

* xm1, ym1 et zm1 sont des champs par points definis sur mail7,
* maillage des points de mail2 (ombre) dont les segments incrementes
* du pas n interseptent la facette en cours. Ces champs par points
* contiennent les coordonnees des intersections entre le segment
* du point considere avec le plan de la facette courante.


* maintenant, on va chercher les coordonnes barycentriques de M dans
* le repere baryentrique forme par les trois sommets de la facette
* en cours A, B, C.

 dxa1 = xm1 - xa1 ;
 dxb1 = xm1 - xb1 ;
 dxc1 = xm1 - xc1 ;
 dya1 = ym1 - ya1 ;
 dyb1 = ym1 - yb1 ;
 dyc1 = ym1 - yc1 ;
 dza1 = zm1 - za1 ;
 dzb1 = zm1 - zb1 ;
 dzc1 = zm1 - zc1 ;

* denominateur suivant les 3 axes :
 Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1)
      +(dya1*dxc1) ;
 Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1)
      +(dza1*dxc1) ;
 Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1)
      +(dya1*dzc1) ;
*
*
 si ((maxi (abs Dz)) > tol2) ;
  D1 = Dz ;
  a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  c1 = (dyb1*dxa1) - (dxb1*dya1) ;
 sinon ;
  si ((maxi (abs Dy)) > tol2) ;
   D1 = Dy ;
   a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
   b1 = (dza1*dxc1) - (dxa1*dzc1) ;
   c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  sinon ;
   D1 = Dx ;
   a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
   b1 = (dya1*dzc1) - (dza1*dyc1) ;
   c1 = (dyb1*dza1) - (dzb1*dya1) ;
  finsi ;
 finsi ;

* calcul de alpha1
 alpha1 = a1 / D1 ;

* calcul de beta1
 beta1 = b1 / D1 ;
*
* calcul de gamma1
 gamma1 = c1 / D1 ;


* si alpha et beta et gama sont tous superieurs ou egaux a 0,
* le point d'intersection est dans la facette et il y a intersection

* CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
 CHINTER1 = (alpha1 masque egsupe 0.) *
            (beta1  masque egsupe 0.) *
            (gamma1 masque egsupe 0.) ;

* PTPRIS1 = CHINTER1 POIN DIFF 0. ;
* mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);

* maillage de noeuds n'ayant pas deja ete intersectes
 chinter3 = CHINTER1 - CHINTER2 ;
 mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;

* CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
 CHINTER2 = CHINTER1 + CHINTER2 ;

* PTPRIS2 = CHINTER2 POIN DIFF 0. ;
* mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);

* on calcule des CHPO reduits aux noeuds intersectes
 xm1_r = redu xm1 mail5 ;
 ym1_r = redu ym1 mail5 ;
 zm1_r = redu zm1 mail5 ;
 xm1_r =  chan 'ATTRIBUT' xm1_r nature discret ;
 ym1_r =  chan 'ATTRIBUT' ym1_r nature discret ;
 zm1_r =  chan 'ATTRIBUT' zm1_r nature discret ;

* concatenation des coordonnees des intersections
 xinter1 = xinter1 et xm1_r ;
 yinter1 = yinter1 et ym1_r ;
 zinter1 = zinter1 et zm1_r ;

 mena ;

fin boucel1 ;
* -- Fin de la grande boucle sur les facettes intersectantes --

* maillage contenant les noeuds intersectes
minter1 = chinter2 poin different 0. ;

*** RM diagnostic
*mess 'nbno minter1' (nbno minter1) ;
*mess 'xinter1' ;
*@listmm xinter1 ;
*mess 'yinter1' ;
*@listmm yinter1 ;
*mess 'zinter1' ;
*@listmm zinter1 ;
*** RM fin diagnostic

* difference symetrique (ou l'on impose PAS)
nointer1 = diff minter1 S_OMBRE4 ;

* calcul du pas sur tout le maillage s_ombre4
 chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;

* distances entre points initiaux et M (uniquement sur noeuds inters)

si ((nbno minter1) > 0) ;
 xinter1r = redu xinter1 minter1 ;
 yinter1r = redu yinter1 minter1 ;
 zinter1r = redu zinter1 minter1 ;

 CH_OLD2r = redu CH_OLD2  minter1 ;
 xp1 = exco X CH_OLD2r ;
 yp1 = exco Y CH_OLD2r ;
 zp1 = exco Z CH_OLD2r ;

 dxmp1 = xp1 - xinter1r ;
 dymp1 = yp1 - yinter1r ;
 dzmp1 = zp1 - zinter1r ;

 chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
 chdmp1 =  chan 'ATTRIBUT' chdmp1 nature diffus ;

 si ((nbno nointer1) > 0) ;
* on peut avoit tout intersecte auquel cas on n a pas a mettre le
* pas pour les autres
  chdist1 = redu chpas0 nointer1 ;
  chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  chdist8 = chdist1 et chdmp1 ;
 sinon ;
   chdist8 = chdmp1 ;
 finsi ;
sinon ;
 chdist8 = chpas0 ;
finsi ;

chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;

*MESS '---------------------------------> exiting @INTERC';

FINPROC chdist9 minter1 ;

debproc inters  mail1*maillage p1*maillage p2*maillage ;

finproc ;
**** @INTSEC

DEBPROC @INTSEC CH_OLD2*CHPOINT CH_NEW2*CHPOINT
                TOL2*FLOTTANT TAB1*TABLE  ;
*
**********************************************
* Procedure (inspiree de @INTERC) calculant  *
* l'intersection des lignes de champ avec un *
* objet constitue de facettes triangulaires  *
* par une methode analytique exacte.         *
*        Alain MOAL (Fevrier 2001)           *
**********************************************
*
*MESS '---------------------------------> calling @INTSEC';

S_OMBRE4  = CH_OLD2 EXTR MAIL ;
dex4 = nomc scal (exco x (CH_NEW2 - CH_OLD2));
dey4 = nomc scal (exco y (CH_NEW2 - CH_OLD2));
dez4 = nomc scal (exco z (CH_NEW2 - CH_OLD2));

xinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
yinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
zinter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
finter1 = manu chpo S_OMBRE4 1 'SCAL' 0. nature 'DISCRET' ;
*
* +++++++++++++++++++++++++++++++++++
* RECHERCHE DES INTERCECTIONS
* +++++++++++++++++++++++++++++++++++
*
* METHODE CHOISIE: on boucle sur les facettes et on travaille sur les
* champs par points des points remontes. Cette methode est adaptee
* a un maillage ombrant reduit et a un maillage ombre volumineux...
*
* --- CHAMP CONTENANT N POUR LES NOEUDS DE OMBRE INTERSECTES N FOIS
*CHINTER2 = manu chpo S_OMBRE4 1 scal 0. 'NATURE' 'DISCRET' ;
CHINTER2 = manu chpo S_OMBRE4 1 scal 0. ;

S_OMBRA3 = extr tab1.<chelx1 mail ;
nel1 = nbel S_OMBRA3 ;

repe boucel1 nel1;

* mess 'facette numero' &boucel1 ;

 el1 = S_OMBRA3 elem &boucel1 ;

* on extrait les coordonnees du point A de la facette
 xa1 = extr tab1.<chelx1 scal 1 &boucel1 1 ;
 ya1 = extr tab1.<chely1 scal 1 &boucel1 1 ;
 za1 = extr tab1.<chelz1 scal 1 &boucel1 1 ;
*
 xb1 = extr tab1.<chelx2 scal 1 &boucel1 1 ;
 yb1 = extr tab1.<chely2 scal 1 &boucel1 1 ;
 zb1 = extr tab1.<chelz2 scal 1 &boucel1 1 ;
*
 xc1 = extr tab1.<chelx3 scal 1 &boucel1 1 ;
 yc1 = extr tab1.<chely3 scal 1 &boucel1 1 ;
 zc1 = extr tab1.<chelz3 scal 1 &boucel1 1 ;

* on extrait le flux normalise en chaque point de la facette
 f1 = extr tab1.<chamf1 scal 1 &boucel1 1 ;
 f2 = extr tab1.<chamf2 scal 1 &boucel1 1 ;
 f3 = extr tab1.<chamf3 scal 1 &boucel1 1 ;

* on calcule les vecteurs APn et APn+1
 apnx1 = (exco X CH_OLD2) - xa1 ;
 apny1 = (exco Y CH_OLD2) - ya1 ;
 apnz1 = (exco Z CH_OLD2) - za1 ;

 apnp1x1 = (exco x CH_NEW2) - xa1 ;
 apnp1y1 = (exco y CH_NEW2) - ya1 ;
 apnp1z1 = (exco z CH_NEW2) - za1 ;

* on extrait les cosinus directeurs de la normale de la facette
 nfx1 = extr tab1.<cosinusx scal 1 &boucel1 1;
 nfy1 = extr tab1.<cosinusy scal 1 &boucel1 1;
 nfz1 = extr tab1.<cosinusz scal 1 &boucel1 1;

* on effectue les produits scalaires.
 ps1 = (apnx1   * nfx1) + (apny1   * nfy1) + (apnz1   * nfz1);
 ps2 = (apnp1x1 * nfx1) + (apnp1y1 * nfy1) + (apnp1z1 * nfz1);
 pp1 = ps1*ps2 ;

* la je suis dans la facette i et je determine quels sont les segments
* PnPn+1 qui traversent le plan de la facette.
* si le produit scalaire est nul, c'est que un des noeuds p1 ou p2 est
* dans le plan de la facette

* segments de part et d'autre de la facette
 mail3 = pp1 poin infe (-1.*tol2*tol2) ;
* si Pn+1 appartient au maillage ombrant
 mail6 = ps2 poin egale 0. ;
 mail7 = mail3 et mail6 ;
 n_mail7 = nbno mail7 ;
 si (ega (n_mail7) 0) ;
  iter boucel1;
 finsi ;

* mail3 est le maillage des noeuds de mail2 pour lesquels le segment incremente
* le long de la ligne de champ intersecte (largement)le plan de la facette
* en cours... c'est a dire qu'on inclut les cas ou Pn ou Pn+1 sont dans le plan
* de la facette
* on va calculer le point d'intersection que pour ces points la.

 dex2 = redu dex4 (mail7) ;
 dey2 = redu dey4 (mail7) ;
 dez2 = redu dez4 (mail7) ;

 chr1 = redu CH_OLD2 (mail7) ;
 chr2 = redu CH_NEW2 (mail7) ;

 chrx1 = nomc scal (exco chr1 x) ;
 chry1 = nomc scal (exco chr1 y) ;
 chrz1 = nomc scal (exco chr1 z) ;


 ad1 = (dex2 * nfx1) + (dey2 * nfy1) + (dez2 * nfz1) ;
* mess 'ad1' ;(list ad1) ;
* on exclu avec une tolerence, les segments qui sont paralleles a la facette
* => on considere qu'il n'y a pas d'intersection pour ces noeuds la
 mail4 = (abs ad1) poin superieur TOL2 ;
 n_mail4 = nbno mail4 ;
* mess 'nb de segments non // a la facette'  n_mail4 ;
 si (ega n_mail4 0) ;
  iter boucel1;
 finsi ;
 ad2   = redu ad1   mail4 ;
 dex3  = redu dex2  mail4 ;
 dey3  = redu dey2  mail4 ;
 dez3  = redu dez2  mail4 ;
 chrx2 = redu chrx1 mail4 ;
 chry2 = redu chry1 mail4 ;
 chrz2 = redu chrz1 mail4 ;

 bx1 = (xa1*dex3*nfx1) - ((((chry2-ya1)*dex3)-(chrx2*dey3))*nfy1)
                       - ((((chrz2-za1)*dex3)-(chrx2*dez3))*nfz1);

 by1 = (ya1*dey3*nfy1) - ((((chrz2-za1)*dey3)-(chry2*dez3))*nfz1)
                       - ((((chrx2-xa1)*dey3)-(chry2*dex3))*nfx1);

 bz1 = (za1*dez2*nfz1) - ((((chrx2-xa1)*dez3)-(chrz2*dex3))*nfx1)
                       - ((((chry2-ya1)*dez3)-(chrz2*dey3))*nfy1);
 xm1 = bx1 / ad2 ;
 ym1 = by1 / ad2 ;
 zm1 = bz1 / ad2 ;

* xm1, ym1 et zm1 sont des champs par points definis sur mail7,
* maillage des points de mail2 (ombre) dont les segments incrementes
* du pas n interseptent la facette en cours. Ces champs par points
* contiennent les coordonnees des intersections entre le segment
* du point considere avec le plan de la facette courante.


* maintenant, on va chercher les coordonnes barycentriques de M dans
* le repere baryentrique forme par les trois sommets de la facette
* en cours A, B, C.

 dxa1 = xm1 - xa1 ;
 dxb1 = xm1 - xb1 ;
 dxc1 = xm1 - xc1 ;
 dya1 = ym1 - ya1 ;
 dyb1 = ym1 - yb1 ;
 dyc1 = ym1 - yc1 ;
 dza1 = zm1 - za1 ;
 dzb1 = zm1 - zb1 ;
 dzc1 = zm1 - zc1 ;

* denominateur suivant les 3 axes :
 Dz = (dyc1*dxb1)-(dxc1*dyb1)+(dxa1*dyb1)-(dxa1*dyc1)-(dya1*dxb1)
      +(dya1*dxc1) ;
 Dy = (dzc1*dxb1)-(dxc1*dzb1)+(dxa1*dzb1)-(dxa1*dzc1)-(dza1*dxb1)
      +(dza1*dxc1) ;
 Dx = (dyc1*dzb1)-(dzc1*dyb1)+(dza1*dyb1)-(dza1*dyc1)-(dya1*dzb1)
      +(dya1*dzc1) ;
*
*
 si ((maxi (abs Dz)) > tol2) ;
  D1 = Dz ;
  a1 = (dyc1*dxb1) - (dxc1*dyb1) ;
  b1 = (dya1*dxc1) - (dxa1*dyc1) ;
  c1 = (dyb1*dxa1) - (dxb1*dya1) ;
 sinon ;
  si ((maxi (abs Dy)) > tol2) ;
   D1 = Dy ;
   a1 = (dzc1*dxb1) - (dxc1*dzb1) ;
   b1 = (dza1*dxc1) - (dxa1*dzc1) ;
   c1 = (dzb1*dxa1) - (dxb1*dza1) ;
  sinon ;
   D1 = Dx ;
   a1 = (dyc1*dzb1) - (dzc1*dyb1) ;
   b1 = (dya1*dzc1) - (dza1*dyc1) ;
   c1 = (dyb1*dza1) - (dzb1*dya1) ;
  finsi ;
 finsi ;

* calcul de alpha1
 alpha1 = a1 / D1 ;

* calcul de beta1
 beta1 = b1 / D1 ;
*
* calcul de gamma1
 gamma1 = c1 / D1 ;
*
* flux normalise au point trouve (sur un triangle a 3 noeuds
* les fonctions de forme sont les coordonnees barycentriques)
fm0 = (alpha1 * f1) + (beta1 * f2) + (gamma1 * f3) ;

* si alpha et beta et gama sont tous superieurs ou egaux a 0,
* le point d'intersection est dans la facette et il y a intersection

* CHPO CONTENANT 1 POUR LES NOEUDS INTERSECTES PAR LA FACETTE COURANTE
 CHINTER1 = (alpha1 masque egsupe 0.) *
            (beta1  masque egsupe 0.) *
            (gamma1 masque egsupe 0.) ;

* PTPRIS1 = CHINTER1 POIN DIFF 0. ;
* mess 'nb noeuds intersectes (pour la facette) =' (nbno PTPRIS1);

* maillage de noeuds n'ayant pas deja ete intersectes
 chinter3 = CHINTER1 - CHINTER2 ;
 mail5 = (abs (chinter3 - 1.)) poin inferieur TOL2 ;

* CHPO CONTENANT N POUR LES NOEUDS INTERSECTES PAR N FACETTES
 CHINTER2 = CHINTER1 + CHINTER2 ;

* PTPRIS2 = CHINTER2 POIN DIFF 0. ;
* mess 'nb noeuds intersectes (pour ttes les facettes) =' (nbno PTPRIS2);

* on calcule des CHPO reduits aux noeuds intersectes
 xm1_r = redu xm1 mail5 ;
 ym1_r = redu ym1 mail5 ;
 zm1_r = redu zm1 mail5 ;
 xm1_r = chan 'ATTRIBUT' xm1_r nature discret ;
 ym1_r = chan 'ATTRIBUT' ym1_r nature discret ;
 zm1_r = chan 'ATTRIBUT' zm1_r nature discret ;
 fm0_r = redu fm0 mail5 ;
 fm0_r = chan 'ATTRIBUT' fm0_r nature discret ;


* concatenation des coordonnees des intersections
 xinter1 = xinter1 et xm1_r ;
 yinter1 = yinter1 et ym1_r ;
 zinter1 = zinter1 et zm1_r ;

* concatenation du flux normalise aux points d'intersection
 finter1 = finter1 et fm0_r ;

mena ;

fin boucel1 ;
* -- Fin de la grande boucle sur les facettes intersectantes --

* maillage contenant les noeuds intersectes
minter1 = chinter2 poin different 0. ;

* difference symetrique (ou l'on impose PAS)
nointer1 = diff minter1 S_OMBRE4 ;

* calcul du pas sur tout le maillage s_ombre4
 chpas0 = ((dex4 * dex4) + (dey4 * dey4) + (dez4 * dez4)) ** 0.5 ;

* flux normalise initialise sur le maillage s_ombre4
 chfn0 = manu chpo S_OMBRE4 1 scal 0. ;

* distances entre points initiaux et M (uniquement sur noeuds inters)

si ((nbno minter1) > 0) ;
 xinter1r = redu xinter1 minter1 ;
 yinter1r = redu yinter1 minter1 ;
 zinter1r = redu zinter1 minter1 ;

 finter1r = redu finter1 minter1 ;
 finter1r = chan 'ATTRIBUT' finter1r nature diffus ;

 CH_OLD2r = redu CH_OLD2  minter1 ;
 xp1 = exco X CH_OLD2r ;
 yp1 = exco Y CH_OLD2r ;
 zp1 = exco Z CH_OLD2r ;

 dxmp1 = xp1 - xinter1r ;
 dymp1 = yp1 - yinter1r ;
 dzmp1 = zp1 - zinter1r ;

 chdmp1 = ((dxmp1 * dxmp1) + (dymp1 * dymp1) + (dzmp1 * dzmp1)) ** 0.5 ;
 chdmp1 =  chan 'ATTRIBUT' chdmp1 nature diffus ;

* champ de deplacement des points interceptes
 dxmp1 = (NOMC UX dxmp1 NATURE DIFFUS) * (-1.) ;
 dymp1 = (NOMC UY dymp1 NATURE DIFFUS) * (-1.) ;
 dzmp1 = (NOMC UZ dzmp1 NATURE DIFFUS) * (-1.) ;
 depmp1 = dxmp1 et dymp1 et dzmp1 ;

 si ((nbno nointer1) > 0) ;
* on peut avoit tout intersecte auquel cas on n a pas a mettre le
* pas pour les autres
  chdist1 = redu chpas0 nointer1 ;
  chdist1 = chan 'ATTRIBUT' chdist1 nature diffus ;
  chdist8 = chdist1 et chdmp1 ;
  chfn1 = redu chfn0 nointer1 ;
  chfn1 = chan 'ATTRIBUT' chfn1 nature diffus ;
  chfn8 = chfn1 et finter1r ;
 sinon ;
   chdist8 = chdmp1 ;
   chfn8 = finter1r ;
 finsi ;
sinon ;
 chdist8 = chpas0 ;
 chfn8 = chfn0 ;
 dxmp1 = (NOMC UX ((exco X CH_OLD2) * 0.) NATURE DIFFUS) ;
 dymp1 = (NOMC UY ((exco Y CH_OLD2) * 0.) NATURE DIFFUS) ;
 dzmp1 = (NOMC UZ ((exco Z CH_OLD2) * 0.) NATURE DIFFUS) ;
 depmp1 = dxmp1 et dymp1 et dzmp1 ;
finsi ;

chdist9 = chan 'ATTRIBUT' chdist8 nature discret ;
chfn9   = chan 'ATTRIBUT' chfn8 nature discret ;

*MESS '---------------------------------> exiting @INTSEC';

FINPROC chdist9 minter1 chfn9 depmp1;

**** IPOE
DEBPROC  IPOE  OBJ_11/FLOTTANT  OBJ_12/LISTREEL    OBJ_13/CHPOINT
               EVO_1*EVOLUTION  MO_1/MOT                      ;
 MESS '>>>>IPOE 30/4/96 Please call now @IPOE  ';
'FINPROC'                              ;
**** @IPOE
DEBPROC  @IPOE  OBJ_11/FLOTTANT  OBJ_12/LISTREEL    OBJ_13/CHPOINT
               EVO_1*EVOLUTION  MO_1/MOT                      ;
*********************************************************
******              PROCEDURE @IPOE                ******
*********************************************************
* INTERPOLATION EN UTILISANT UNE EVOLUTION
*--------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1          2        3          4         5         6        7
 LRE_1 = EXTR  EVO_1 'ABSC'  1                                 ;
 LRE_2 = EXTR  EVO_1 'ORDO'  1                                 ;
SI ( NON (EXISTE MO_1))                                       ;
 MO_2 = MOT 'SANS'                                            ;
SINON                                                         ;
 MO_2 = MO_1                                            ;
FINSI                                                          ;
SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' ))                  ;
 SI ( EXISTE  OBJ_11 )                                         ;
  OBJ_2 = @ITPLT  LRE_1  LRE_2  MO_2  OBJ_11                       ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_12 )                                         ;
  OBJ_2 = @ITPLT  LRE_1  LRE_2  MO_2  OBJ_12                       ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_13 )                                         ;
  OBJ_2 = @ITPLT  LRE_1  LRE_2  MO_2  OBJ_13                       ;
 FINSI                                                         ;
SINON                                                         ;
 SI ( EXISTE  OBJ_11 )                                         ;
  OBJ_2 = IPOL  OBJ_11 LRE_1  LRE_2                              ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_12 )                                         ;
  OBJ_2 = IPOL  OBJ_12 LRE_1  LRE_2                              ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_13 )                                         ;
  OBJ_2 = IPOL  OBJ_13 LRE_1  LRE_2                              ;
 FINSI                                                         ;
FINSI                                                         ;
FINPROC  OBJ_2                                                 ;
**** @ITPLT

DEBPROC  @ITPLT  LR_1*LISTREEL  LR_2*LISTREEL MO_1*MOT
       OBJ_11/FLOTTANT  OBJ_12/LISTREEL    OBJ_13/CHPOINT      ;

*23456789012345678901234567890123456789012345678901234567890123456789012
*        1          2        3          4         5         6        7

*********************************************************
******              PROCEDURE @ITPLT                ******
********************************************************************
* INTERPOLATION A PARTIR DE 2 LISTREELS AVEC EXTRAPOLATION POSSIBLE
*-------------------------------------------------------------------

SI ( NON (( EGA MO_1 'LINE') OU ( EGA MO_1 'FIXE')) )           ;
 MESS '>>>@ITPLT>>> ON VOULAIT LE MOT  LINE OU FIXE'             ;
 MESS '>>>@ITPLT>>> ON NE FAIT RIEN'                             ;
 ERREUR 2                                                       ;
FINSI                                                         ;
SI ( EXISTE  OBJ_11 )                                         ;
 OBJ_1 =   OBJ_11                                ;
 VMA_1 =  OBJ_1                                  ;
 VMI_1 =  OBJ_1                                  ;
FINSI                                                         ;
SI ( EXISTE  OBJ_12 )                                         ;
 OBJ_1 =  OBJ_12                                              ;
 VMA_1 =   MAXI OBJ_1                                  ;
 VMI_1 =   MINI OBJ_1                                  ;
FINSI                                                         ;
SI ( EXISTE  OBJ_13 )                                         ;
 OBJ_1 =   OBJ_13                                      ;
 VMA_1 =   MAXI OBJ_1                                  ;
 VMI_1 =   MINI OBJ_1                                  ;
FINSI                                                  ;

SI  (( VMA_1 < ( MAXI LR_1)) ET  ( VMI_1 > ( MINI LR_1))  )  ;
 OBJ_2 = IPOL  OBJ_1 LR_1  LR_2                              ;
SINON                                                        ;
 LRE_1 = LR_1                                                ;
 LRE_2 = LR_2                                                ;
 DVAL = ( MAXI ( ABS LR_1 ) ) / 100.                         ;
 SI  ( NON ( VMA_1 < ( MAXI LR_1)) )                          ;
  N1 = DIME LR_1                                                ;
  VX_F = EXTR LR_1 N1                                            ;
  VX_F1 = EXTR LR_1 ( N1 - 1 )                                   ;
  VY_F = EXTR LR_2 N1                                            ;
  VY_F1 = EXTR LR_2 ( N1 - 1 )                                   ;
  VX_1  = VMA_1 + DVAL                                        ;
  SI (EGA MO_1 'LINE' )                                         ;
   VY_1 = VY_F + ((VY_F - VY_F1) * (VX_1 - VX_F)/(VX_F - VX_F1)) ;
  SINON                                                           ;
   VY_1 = VY_F                                                    ;
  FINSI                                                          ;
  LRE_1 = LRE_1 ET ( PROG  VX_1 )                                ;
  LRE_2 = LRE_2 ET ( PROG  VY_1 )                                ;
*  MESS '>>1 VAL XMAX YMAX XEXT YEXT' VMA_1 VX_F VY_F VX_1 VY_1 ;
 FINSI                                                          ;
 SI  ( NON ( VMI_1 > ( MINI LR_1)) )                          ;
  VX_I = EXTR LR_1 1                                            ;
  VX_I1 = EXTR LR_1 2                                           ;
  VY_I = EXTR LR_2 1                                            ;
  VY_I1 = EXTR LR_2 2                                           ;
  VX_1 = VMI_1 - DVAL                                           ;
  SI (EGA MO_1 'LINE' )                                         ;
   VY_1 = VY_I + ((VY_I - VY_I1) * (VX_1 - VX_I)/(VX_I - VX_I1)) ;
  SINON                                                           ;
   VY_1 = VY_I     ;
  FINSI                                                           ;
  LRE_1 = ( PROG  VX_1 ) ET  LRE_1                              ;
  LRE_2 = ( PROG  VY_1 ) ET  LRE_2                             ;
*  MESS '>>>@ITPLT>>> extrapolation VAL XMIN YMIN XEXT YEXT';
*  MESS   VMI_1 VX_I VY_I VX_1 VY_1 ;
 FINSI                                                          ;
 OBJ_2 = IPOL  OBJ_1 LRE_1  LRE_2                              ;
FINSI                                                          ;

FINPROC  OBJ_2                                                 ;
**** @LECTB

DEBPROC @LECTB TAB1*TABLE ;
*
***********************************************************
* Procedure de lecture de la carte de champ magnetique    *
* et de dpsi dans un fichier issu de PROTEUS.             *
*                 Alain MOAL (Fevrier 2001)               *
***********************************************************
* Modif :                                                 *
* 08/11/01 (A.MOAL) : lecture et carte de dpsi            *
***********************************************************
*
MESS '---------------------------------> calling @LECTB';
*
*--------------- VARIABLES D'ENTREE :
NOM0 = TAB1.<NOM_FICHIER_B      ;
ANG0 = TAB1.<EXTENSION_TORO     ;
NBE0 = TAB1.<NBELEM_TORO        ;
CT0  = TAB1.<CENTRE_TORE        ;
CT1  = TAB1.<POINT_SUR_AXE_TORE ;
*------------------------------------
*
OPTI ACQUERIR NOM0 ;
*---- lecture du nombre de lignes a lire dans le fichier
ACQU NBR1*ENTIER NBZ1*ENTIER FLREF1*FLOTTANT FLREF2*FLOTTANT ;
I = NBR1 * NBZ1 ;
MESS '@LECTB IS READING 'I' LINES IN FILE 'NOM0 ;
MESS 'NODES NUMBER (DIRECTION R) : 'NBR1 ;
MESS 'NODES NUMBER (DIRECTION Z) : 'NBZ1 ;

I = NBR1 * NBZ1 ;
*
ACQU R0*FLOTTANT  Z0*FLOTTANT  FLUX1*FLOTTANT
     BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT DPSI1*FLOTTANT;
*
*---- creation du premier point support du champ
*---- tourne de 1 degre pour etre sur d'envelopper
*---- le domaine d'etude
P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
*
*---- creation du chpoint s'appuyant sur ce point
CHPT = MANU CHPO P0 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1
                      'BPHI' BTOR1 'DPSI' DPSI1
                      'NATURE' DISCRET ;
*
*---- boucle sur les points dans la direction toroidale
J = 0 ;
REPETER BOUC0 NBE0 ;
   J = J + 1 ;
   P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
   CHP01 = MANU CHPO P01 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1
                           'BPHI' BTOR1 'DPSI' DPSI1
                           'NATURE' DISCRET ;
   CHPT = CHPT ET CHP01 ;
FIN BOUC0 ;
*
*---- boucle sur les I-1 autres lignes du tableau
REPETER BOUC1 (I-1) ;
   ACQU R1*FLOTTANT  Z1*FLOTTANT  FLUX1*FLOTTANT
        BR1*FLOTTANT BZ1*FLOTTANT BTOR1*FLOTTANT
        DPSI1*FLOTTANT;
   P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
   CHP1 = MANU CHPO P1 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1
                         'BPHI' BTOR1 'DPSI' DPSI1
                         'NATURE' DISCRET ;
   CHPT = CHPT ET CHP1 ;
   J = 0 ;
   REPETER BOUC2 NBE0 ;
      J = J + 1 ;
      P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
      CHP11 = MANU CHPO P11 5 'FLUX' FLUX1 'BR' BR1 'BZ' BZ1
                              'BPHI' BTOR1 'DPSI' DPSI1
                              'NATURE' DISCRET ;
      CHPT = CHPT ET CHP11 ;
   FIN BOUC2 ;
FIN BOUC1 ;

MAIL1 = EXTR CHPT 'MAIL' ;
VECB  = VECT CHPT 0.03 'BR' 'BZ' ROUGE ;
*
*---- projection sur un maillage
P0  = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
P1  = (R1 0. Z1) TOUR (-1.) CT0 CT1 ;
P01 = (R0 0. Z1) TOUR (-1.) CT0 CT1 ;
P10 = (R1 0. Z0) TOUR (-1.) CT0 CT1 ;
L1  = P0 D (NBR1-1) P10 ;
L2  = P10 D (NBZ1-1) P1 ;
L3  = P1 D (NBR1-1) P01 ;
L4  = P01 D (NBZ1-1) P0 ;
S1  = (DALLER L1 L2 L3 L4 PLAN) COUL BLEU ;
VOL1 = S1 VOLU ROTA NBE0 (ANG0+2.) CT0 CT1 ;
*
*---- critere d'elimination inferieur a la taille de maille
*---- dans le plan (R,Z)
DIST1 = (MESU L1) / (5. * (NBR1-1)) ;
DIST2 = (MESU L4) / (5. * (NBZ1-1)) ;
SI (DIST1 >EG DIST2) ;
   DIST0 = DIST2 ;
SINON ;
   DIST0 = DIST1 ;
FINSI ;
ELIM DIST0 (VOL1 ET MAIL1) ;
*TITRE ' ';
*TRAC (VOL1 ET MAIL1) ;
*
*---- trace pour verification
CHPFLU = EXCO 'FLUX' CHPT ;
TITRE 'MAGNETIC FLUX' ;
TRAC 30 CHPFLU VOL1 ;
CHDPSI = EXCO 'DPSI' CHPT ;
TITRE 'DPSI' ;
TRAC 30 CHDPSI VOL1 ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.<CARTE_B  = CHPT ;
TAB1.<GRILLE_B = VOL1 ;
*------------------------------------
*
MESS '---------------------------------> exiting @LECTB';
*
FINPROC ;
**** @LECTF

DEBPROC @LECTF TAB1*TABLE ;
*
***********************************************************
* Procedure de lecture du flux normalise sur une ligne    *
* dans un fichier issu de PROTEUS.                        *
*                 Alain MOAL (Fevrier 2001)               *
***********************************************************
*
MESS '---------------------------------> calling @LECTF';
*
*--------------- VARIABLES D'ENTREE :
NOM0 = TAB1.<NOM_FICHIER_F      ;
ANG0 = TAB1.<EXTENSION_TORO     ;
NBE0 = TAB1.<NBELEM_TORO        ;
CT0  = TAB1.<CENTRE_TORE        ;
CT1  = TAB1.<POINT_SUR_AXE_TORE ;
*------------------------------------
*
OPTI ACQUERIR NOM0 ;
*---- lecture du nombre de lignes a lire dans le fichier
ACQU I*ENTIER ;
MESS '@LECTF IS READING 'I' LINES IN FILE 'NOM0 ;
*
*---- ligne de titre
ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT
     MOT6*MOT MOT7*MOT ;
*
ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT
     AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT
     Q1*FLOTTANT ;
*
*---- creation du premier point support du champ
*---- tourne de 1 degre pour etre sur d'envelopper
*---- le domaine d'etude
P0 = (R0 0. Z0) TOUR (-1.) CT0 CT1 ;
*
*---- creation du chpoint s'appuyant sur ce point
FLUN0 = MANU CHPO P0 1 SCAL Q1 NATURE DISCRET ;
*
*---- boucle sur les points dans la direction toroidale
J = 0 ;
REPETER BOUC0 NBE0 ;
   J = J + 1 ;
   P01 = P0 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
   CHP01 = MANU CHPO P01 1 SCAL Q1 NATURE DISCRET ;
   FLUN0 = FLUN0 ET CHP01 ;
FIN BOUC0 ;
*
*---- boucle sur les I-1 autres lignes du tableau
REPETER BOUC1 (I-1) ;
   ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT
        AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT
        Q1*FLOTTANT ;
   P1 =( R1 0. Z1) TOUR (-1.) CT0 CT1 ;
   CHP1 = MANU CHPO P1 1 SCAL Q1 NATURE DISCRET ;
   FLUN0 = FLUN0 ET CHP1 ;
   J = 0 ;
   REPETER BOUC2 NBE0 ;
      J = J + 1 ;
      P11 = P1 TOUR ((ANG0+2.+1.e-2) * J / NBE0) CT0 CT1 ;
      CHP11 = MANU CHPO P11 1 SCAL Q1 NATURE DISCRET ;
      FLUN0 = FLUN0 ET CHP11 ;
   FIN BOUC2 ;
FIN BOUC1 ;
MAIL1 = EXTR FLUN0 'MAIL' ;
*
*---- projection sur un maillage
L1 = P0 D (I-1) P1 ;
S1 = L1 ROTA NBE0 (ANG0+2.) CT0 CT1 ;
*
*---- critere d'elimination inferieur a la taille de maille
*---- dans le plan (R,Z)
DIST1 = (MESU L1) / (5. * (I-1)) ;
ELIM DIST1 (S1 ET MAIL1) ;
*
*---- trace pour verification
TITRE 'NORMALISED FLUX' ;
EVOL1 = EVOL ROUG CHPO (REDU FLUN0 L1)  L1 ;
DESS EVOL1 ;
TRAC 30 FLUN0 S1 ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.<FLUX_NORMALISE = FLUN0 ;
TAB1.<MAILLAGE_FN    = S1 ;
*------------------------------------
*
MESS '---------------------------------> exiting @LECTF';
*
FINPROC ;
**** @LISTMM
DEBPROC @LISTMM CHAM1/MCHAML CHP1/CHPOINT;

 SI (EXISTE CHAM1);
  CH1 = CHAM1 ;
 SINON;
  SI (EXISTE CHP1);
   CH1 = CHP1;
  SINON ;
   ERRE 'IL MANQUE LE CHAMPS';
  FINSI ;
 FINSI ;
 MESS ' ';

 DD1 = DIME (EXTR CH1 COMP);
 SI (DD1 > 1 );
  MESS 'BEWARE ! the field has more than one component';
 FINSI ;

 MIN1 = MINI CH1;
 MAX1 = MAXI CH1;
 PRE1 = '                        ';
 MES1 = CHAIN PRE1 'mini ' MIN1 ' maxi ' MAX1;
 MESS MES1;
FINPROC ;
**** LUMIN
* @LUMIN LINC2 PENDO1 TAB1 PHIENDO ;
*>LINC2 =  LINC2; >POI1=PENDO1 ;>PHI1=PHIENDO;
DEBPROC @LUMIN >LINC2*MAILLAGE >POI1/POINT
TAB1*TABLE  >PHI1/FLOTTANT;
MESS '>>>>>> DEBUT    @LUMIN >>>>>>>PHI=' >PHI1;
TEMP1 = NOMC SCAL TAB1.TEMPERATURE ;
*CHX1 = COOR 1 TAB1.LFLUX_EXTE_DESS;
*EVTEMX =  EVOL BLEU CHPO CHX1 SCAL TAB1.LFLUX_EXTE_DESS;
*DESS EVTEMX ;
*LIX1 = EXTR EVTEMX 'ORDO' ;
*LIT1 = EXTR EVTEMI 'ORDO' ;
*EVTXI = EVOL MANU LIX1 LIT1 ;
*DESS EVTXI;
 >X3 = REDU TAB1.C_COTETF1 >LINC2 ;
 >Y3 = REDU TAB1.C_SITETF1 >LINC2 ;
 T3 = ATG >Y3 >X3 ;
 TITRE ' angle des normales a la ligne';
 EV3 = EVOL CHPO T3 >LINC2 ;
DESS EV3;
 >Z3 = 0. ;
* SINL1 = REDU TAB1.C_SITETF1  >LINC2;
*   CHPX = EXCO SCAL ( 1. * ( COTETF1 ) ) UX      ;
*   CHPY = EXCO SCAL ( 1. * ( SITETF1 ) ) UY      ;
*   CHPT = (@ET CHPX CHPY  );
*   VEC22 = @VECADA CHPT ( 1. *  0.01 )  'ROUGE' ;
*   TRAC 'CACH'  TAB1.NISOV TEMP1 SAIG1 VEC22 (CONT SAIG1);
SI( EXISTE >POI1) ;
 >X11 >Y1 = COOR >POI1 ;
 >X2 >Y2 = COOR >LINC2;
 XCT1 = COOR 1 TAB1.<CENTRE_TORE ;
 >R1 =  >X11 - XCT1 ;
 >R0 =  2.4 ;
 >PHI0 = >PHI1 - 15. ;
 >X1 = >R1 * (COS >PHI1) +  XCT1 ;
 >X0 = >R0 * (COS >PHI0) +  XCT1 ;
 DX0 = >X2 - >X0 ;
 DZ0 =  (>Y2 *  0. ) - (( SIN >PHI0) * >R0 ) ;
* RHO est la distance entre le point courant et le centre du champ
 RHO =  ((DX0 ** 2) + (DZ0 ** 2)) ** 0.5 ;
* RHO0 est la distance maximale entre un point courant et le centre du champ
 RHO0 = 0.69 ;
* Lint est la longueur d'integration au niveau du point courant
 Lint =(( RHO * RHO * 0.14 / RHO0/RHO0) + 1.) * 4.77E-3 ;
 TITRE  'Pas d integration  avant correction' >PHI1 ;
 EVLint =  EVOL ROUG CHPO Lint SCAL TAB1.LFLUX_EXTE_DESS;
 DESS EVLint ;

* ETEND est l'etendue geometrique normalisee a 1 au centre du champ
 ETEND= RHO * RHO / RHO0 / RHO0 * -0.1  +  1. ;
 TITRE  'etendue geometrique normalisee' >PHI1;
 EVEG =  EVOL ROUG CHPO ETEND SCAL TAB1.LFLUX_EXTE_DESS;
 DESS EVEG ;

 DX1 = >X2 - >X1 ;
 DY1 = >Y2 - >Y1 ;
 DZ1 =  (>Y2 *  0. ) - (( SIN >PHI1) * ( >X11 - XCT1)) ;
 TITRE ' DZ1 en tout point de la ligne ';
 EV5 = EVOL CHPO DZ1 >LINC2 ;
* DESS EV5;
 TITRE ' DX1 en tout point de la ligne ';
 EV5 = EVOL CHPO DX1 >LINC2 ;
* DESS EV5;
 NDX = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
 DX1 = DX1 / NDX;
 DY1 = DY1 / NDX;
 DZ1 = DZ1 / NDX;
 COSL1 = ( (((DY1 * >Z3) - (DZ1 * >Y3)) ** 2 ) +
           (((DZ1 * >X3) - (DX1 * >Z3)) ** 2 ) +
           (((DX1 * >Y3) - (DY1 * >X3)) ** 2 )) ** 0.5 ;
 SINL1 = (((COSL1 ** 2) * -1.) + 1.) ** 0.5 ;
 ANGL1 = ATG   COSL1 SINL1;
 TITRE ' angle normales - point endoscope ' >PHI1;
 EV3 = EVOL CHPO ANGL1 >LINC2 ;
 DESS EV3;
* Le COSL1 est la pour tenir compte du fait que la resolution spatiale donnee
*  par MIGOZZI est une resolution perpendiculaire a l'axe optique (que l'on
*  projette sur l'aiguille.
 Lint = Lint / (COS  ANGL1) ;
 TITRE  '1/cos de l angle' >PHI1 ;
 EV3 = EVOL CHPO ((COS ANGL1)**-1) >LINC2 ;
 DESS EV3;
 TITRE  'Pas d integration apres correction' >PHI1;
 EV3 = EVOL CHPO Lint >LINC2 ;
 DESS EV3;
FINSI ;
 EMISSIV1 = 1.;
 PLANKC1 = 3.74E-16 ;
 PLANKC2 = 1.44E-2  ;
 PLANKL  = 4.E-6    ;
 PLANKLM5 = PLANKL ** -5 ;
 PI = 3.14159  ;
 TEMP2 = REDU TEMP1  >LINC2;
 LUMI1  =
 ( ((( EXP ((( TEMP2 *  PLANKL) ** -1 ) * PLANKC2)) - 1.) * PI)
          ** -1 ) * EMISSIV1 * PLANKC1 * PLANKLM5 ;
* LUMI2 = LUMI1 * SINL1 ;
  LUMI2 = LUMI1 * ETEND ;
  EVTEML1 = EVOL ROUG CHPO LUMI1 SCAL >LINC2;
  EVTEML2 = EVOL VERT CHPO LUMI2 SCAL >LINC2;
 TAB3 = TABLE ;
 TAB3.1 = 'MARQ CROI REGU MOT TITR LUMINES' ;
 TAB3.2 = 'MARQ TRIA REGU MOT TITR LUMI*EG' ;
 TAB3.3 = 'MARQ CARR REGU MOT TITR INTGLUMI' ;
* DESS (EVTEML1 ET EVTEML2)   MIMA LEGE TAB3 ;
 CHX1 = COOR 1 >LINC2;
 EVTEMX =  EVOL BLEU CHPO CHX1 SCAL >LINC2;
 LIX1 = EXTR EVTEMX 'ORDO' ;
 LIL1 = EXTR EVTEML1 'ORDO' ;
 LIL2 = EXTR EVTEML2 'ORDO' ;
 EVLXI1 = EVOL ROUG MANU LIX1 LIL1 ;
 EVLXI2 = EVOL VERT MANU LIX1 LIL2 ;
* DESS (EVLXI1 ET EVLXI2)  MIMA LEGE TAB3;
 IL = 0 ;
 REPETER BLUMI (NBNO >LINC2) ;
  IL = IL + 1;
  >PL1 = >LINC2 POINT IL ;
  XL1 = COOR 1 >PL1 ;
  XLINC2 = COOR 1 >LINC2 ;
  >PASL = Lint EXTR 'SCAL' >PL1  ;
  XLINF = XL1 - (>PASL / 2.) ;
  XLSUP = XL1 + (>PASL / 2.);
  MASL1 = MASQUE XLINC2 EGINFE XLSUP ;
  MASL2 = MASQUE XLINC2 EGSUPE XLINF;
  MASLT = MASL1 * MASL2;
  LUMI3 = LUMI2 * MASLT ;
  EVTEML3 = EVOL ROSE CHPO LUMI3 SCAL >LINC2;
  LIL3 = EXTR EVTEML3 'ORDO' ;
  EVLXI3 =  EVOL ROUG MANU LIX1 LIL3;
* DESS (EVLXI3 )  ;
  IRR = 0;
  LIL3B = LIL3 ;
  LIX1B = LIX1;
  SI ( XLINF >EG (MINI LIX1)) ;
   IRANGI1 = ( LIX1 MASQUE INFERIEUR SOMME XLINF) + 1;
   IRANGI2 = IRANGI1 + 1;
   VINF =  @ITPLT LIX1 LIL2 'FIXE' XLINF ;
   LIL3B = INSE LIL3B IRANGI1 0. ;
   LIL3B = INSE LIL3B IRANGI2 VINF ;
   LIX1B = INSE LIX1 IRANGI1 (XLINF - 1.E-6) ;
   LIX1B = INSE LIX1B IRANGI2 XLINF;
   IRR = 2;
  FINSI;
  SI ( XLSUP <EG (MAXI LIX1)) ;
   IRANGS1 = (MASQUE LIX1 INFERIEUR SOMME XLSUP) + 1 + IRR;
   IRANGS2 = IRANGS1 + 1;
   VSUP =  @ITPLT LIX1 LIL2 'FIXE' XLSUP ;
   LIL3B = INSE LIL3B IRANGS1 VSUP ;
   LIL3B = INSE LIL3B IRANGS2 0 ;
   LIX1B = INSE LIX1B IRANGS1 XLSUP ;
   LIX1B = INSE LIX1B IRANGS2 (XLSUP + 1.E-6) ;
  FINSI;
  EVLXI3B =  EVOL BLEU MANU LIX1B LIL3B;
* DESS (EVLXI3 ET EVLXI3B)   ;
  MOYLU3 = (SOMM   EVLXI3B) /  >PASL ;
  SI ( IL EGA 1 ) ;
   CHPM3 = MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET ;
  SINON ;
   CHPM3 =CHPM3 ET
       (MANU CHPO >PL1 1 'SCAL' MOYLU3 NATURE DISCRET) ;
  FINSI;
 FIN BLUMI ;
 EVTEML4 = EVOL ROSE CHPO CHPM3 SCAL >LINC2;
 LIL4 = EXTR EVTEML4 'ORDO' ;
 EVLXI4 = EVOL ROSE MANU LIX1 LIL4 ;
 TITRE ' Luminescence' >PHI1 ;
 DESS (EVLXI1 ET EVLXI2 ET EVLXI4 )  MIMA LEGE TAB3 ;
 CHT4 =  (((LOG (((CHPM3 * PI) ** -1) * EMISSIV1 *
          PLANKC1 * PLANKLM5 + 1.)) * PLANKL) ** -1) *  PLANKC2 ;
 TEMP4 = REDU CHT4  >LINC2;
  EVTE2 = EVOL VERT CHPO TEMP2 SCAL >LINC2;
  EVTE4 = EVOL ROUG CHPO TEMP4 SCAL >LINC2;
  LTE2 = EXTR EVTE2 'ORDO' ;
  LTE4 = EXTR EVTE4 'ORDO' ;
  TITRE ' Temperatures mesurees' ;
  TAB1.EVLL4 = EVOL ROUG MANU LIX1 LTE4 ;
  TITRE ' Temperatures initiales' ;
  TAB1.EVLL2 = EVOL VERT MANU LIX1 LTE2 ;
  TAB1.ANGLUMI = ANGL1 ;
MESS '>>>>>> FIN    @LUMIN >>>>>>>>>>' ;
FINPROC ;


**** @MAGNB

DEBPROC @MAGNB TAB1*TABLE ;

***********************************************************
* Procedure de calcul du champ magnetique en chaque point *
* d'un maillage donne.    Alain MOAL (Fevrier 2001)       *
***********************************************************
*
MESS '---------------------------------> calling @MAGNB';
*
*--------------- VARIABLES D'ENTREE :
CHB0   = TAB1.<CARTE_B    ;
GRILB0 = TAB1.<GRILLE_B   ;
MAIL1  = TAB1.<MAILLAGE_B ;
*------------------------------------
*TRAC (MAIL1 ET GRILB0) ;
CHEL1 = CHAN CHAM CHB0 GRILB0 ;
CHPO1 = PROI MAIL1 CHEL1 1.E-4;
BR = EXCO 'BR' CHPO1 ;
BZ = EXCO 'BZ' CHPO1 ;
BPHI = EXCO 'BPHI' CHPO1 ;
*
MESS '---------------------------------> exiting @MAGNB';
FINPROC BR BZ BPHI ;

 'DEBPROC' MATHPLAS TABTEM*'TABLE' TEPMAT*'TABLE' ;
*-----------------------------------------------------------------*
*                                                                 *
*                       M A T H P L A S                           *
*                       ---------------                           *
*                                                                 *
*   Construction des champs d{finissant un mat{riau pour un       *
*   calcul thermoplastique. Pour chaque {l{ment, les valeurs      *
*   des coefficients YOUN, NU, RHO, ALPH ainsi que la courbe      *
*   de traction seront {tablis en fonction de la carte de         *
*   temp{rature et du r{seau de courbes de traction.              *
*                                                                 *
*   En entr{e :                                                   *
*                                                                 *
*   TABTEM                  Table contenant :                     *
*   indice 'NCHAMP'         nombre de champs thermiques (ENTIER)  *
*   indice i                carte de temp{rature @ l'instant n›i  *
*                           (CHPOINT)                             *
*   indice 'PALIER'         option : n› du champ @ partir duquel  *
*                           il y a un palier dans le chargement   *
*                           et reste inchang{ apr}s (ENTIER)      *
*   TEPMAT                  Table contenant :                     *
*   indice 'MAILLAGE'       le maillage de la structure           *
*   indice 'NBPTRAC'        le nombre de points contenus dans     *
*                           les courbes de traction (ENTIER)      *
*   indice 'DEFO'           la table TABEPS contenant :           *
*   indice i                les abscisses de la i-}me normale     *
*                           aux courbes de traction (LISTREEL)    *
*   indice 'CONT'           la table TABSIG contenant :           *
*   indice i                les ordonn{es de la i-}me normale     *
*                           aux courbes de traction (LISTREEL)    *
*   Remarque :              i varie entre 1 et NBPTRAC            *
*   indice 'LISTEMP'        liste des temp{ratures correspondant  *
*                           aux courbes de traction (LISTREEL)    *
*   indice 'EVOALPH'        ALPHA(T) (EVOLUTION) ou               *
*   indice 'VALALPH'        ALPHA    (REEL)                       *
*   indice 'EVONU'          NU(T)    (EVOLUTION) ou               *
*   indice 'VALNU'          NU       (REEL)                       *
*   indice 'EVORHO'         RHO(T)   (EVOLUTION) ou               *
*   indice 'VALRHO'         RHO      (REEL)                       *
*   Remarque :              si objet EVOLUTION : 'ALPH' 'NU' ou   *
*                           'RHO' en abscisse et 'T' en ordonn{e  *
*   En sortie :                                                   *
*                                                                 *
*   indice 'MODELE'         objet mod}le (MMODEL)                 *
*   indice 'MATERIAU'       table contenant :                     *
*   indice i                champ d{finissant le mat{riau au      *
*                           i-}me pas de calcul (MCHAML)          *
*                                                                 *
*   Remarques : 1) l'objet mod}le sera obligatoirement du type    *
*   'MECANIQUE' 'ELASTIQUE' 'PLASTIQUE' 'ISOTROPE' 'typelem'      *
*   et il sera cr{{ une fois pour toutes;                         *
*               2) le module d'Young {tant la pente @ l'origine   *
*   de la courbe de traction, sa donn{e n'est pas n{cessaire.     *
*                                                                 *
*   Denis ROBERT, le 14 f{vrier 1992.                             *
*-----------------------------------------------------------------*
* si IMESS  = VRAI : impressions des champs d{finissant le mat{riau
 IMESS   = FAUX ;
*
 GEO1    = TEPMAT.'MAILLAGE' ;
 NBPTRAC = TEPMAT.'NBPTRAC' ;
 LISTEMP = TEPMAT.'LISTEMP' ;
 TABEPS  = TEPMAT.'DEFO' ;
 TABSIG  = TEPMAT.'CONT' ;
 TABMAT  = TABLE ;
 TABMOD  = TABLE ;
 NTHER   = TABTEM.'NCHAMP' ;
*
 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
    NTHER = TABTEM.'PALIER' ;
 'FINSI' ;
 'SI' ( 'EXISTE' TEPMAT 'VALALPH' ) ;
    IALPH = 1 ; ALPIEL1 = TEPMAT.'VALALPH' ;
 'SINON' ;
    IALPH   = 2 ;
    LISALP1 = 'EXTR' TEPMAT.'EVOALPH' 'ALPH' ;
    LISTE2  = 'EXTR' TEPMAT.'EVOALPH' 'T' ;
 'FINSI' ;
 'SI' ( 'EXISTE' TEPMAT 'VALRHO' ) ;
    IRHO = 1 ; RHOIEL1 = TEPMAT.'VALRHO' ;
 'SINON' ;
    IRHO    = 2 ;
    LISRHO1 = 'EXTR' TEPMAT.'EVORHO' 'RHO' ;
    LISTE3  = 'EXTR' TEPMAT.'EVORHO' 'T' ;
 'FINSI' ;
 'SI' ( 'EXISTE' TEPMAT 'VALNU' ) ;
    INU = 1 ; NUIEL1 = TEPMAT.'VALNU' ;
 'SINON' ;
    INU    = 2 ;
    LISNU1 = 'EXTR' TEPMAT.'EVONU' 'NU' ;
    LISTE4 = 'EXTR' TEPMAT.'EVONU' 'T' ;
 'FINSI' ;
 'SI' ( IMESS ) ;
    'SAUTER' 1 'LIGNE' ;
    'MESS' '*** MAt{riau THermoPLAStique ***' ;
    'SAUTER' 1 'LIGNE' ;
 'FINSI' ;
*
* Types d'{l{ments-finis du maillage / Nombre de types / Nombre
* d'{l{ments d'un type
*
 LESTYPS = GEO1 'ELEM' 'TYPE' ;
 NBTYP1  = 'DIME' LESTYPS ;
 NBTYPEL = 'NBEL' GEO1 LESTYPS ;
*
*   Boucle sur les types d'{l{ments-finis
*
 ITYP1 = 0 ;
 'REPETER' BOUTYPEL NBTYP1 ;
    ITYP1  = ITYP1 + 1 ;
    NBEL1  = 'EXTRAIRE' NBTYPEL ITYP1 ;
    NOMEL1 = 'EXTRAIRE' LESTYPS ITYP1 ;
*
*   Boucle sur les {l{ments du maillage
*
    IEL = 0 ;
    'REPETER' BOUCELEM NBEL1 ;
       IEL = IEL + 1 ;
       'SI' ( NBTYP1 '>EG' 2 ) ;
          IELEM1 = GEO1 'ELEM' NOMEL1 IEL ;
       'SINON' ;
          IELEM1 = GEO1 'ELEM' IEL ;
       'FINSI' ;
*
*      Boucle sur la liste de champs de temp{rature
*
       ITHER = 0 ;
       'REPETER' BOUCTHER NTHER ;
          ITHER  = ITHER + 1 ;
          CHTER  = TABTEM.ITHER ;
          CHTEL1 = 'REDU' CHTER IELEM1 ;
          TMOY = 0. ;
          NNIEL1 = 'NBEL' IELEM1 ;
*
*         Boucle sur les points du i-}me {l{ment
*
          J1 = 0 ;
          'REPETER' BOUCPOIN NNIEL1 ;
             J1 = J1 + 1 ;
             POIN1 = IELEM1 'POIN' J1 ;
             TEXTR = 'EXTR' CHTEL1 'T' POIN1 ;
             TMOY = TMOY + TEXTR ;
          'FIN' BOUCPOIN ;
          TMOY = TMOY / NNIEL1 ;
          'SI' ( IALPH 'EGA' 2 ) ;
             ALPIEL1 = 'IPOL' TMOY LISTE2 LISALP1 ;
          'FINSI' ;
          'SI' ( IRHO 'EGA' 2 ) ;
             RHOIEL1 = 'IPOL' TMOY LISTE3 LISRHO1 ;
          'FINSI' ;
          'SI' ( INU 'EGA' 2 ) ;
             NUIEL1 = 'IPOL' TMOY LISTE4 LISNU1 ;
          'FINSI' ;
*
*         Boucle sur le nombre de points des courbes de traction
*+*
          IPTRAC = 0 ;
          LEPSIEL1 = 'PROG' 0. ;
          LSIGIEL1 = 'PROG' 0. ;
          'REPETER' BOUTRAC NBPTRAC ;
             IPTRAC = IPTRAC + 1 ;
             XX = 'IPOL' TMOY LISTEMP TABEPS.IPTRAC ;
             YY = 'IPOL' TMOY LISTEMP TABSIG.IPTRAC ;
*
*            Le module d'Young est la pente de la courbe de traction
*
             'SI' ( IPTRAC 'EGA' 1 ) ;
                YOUIEL1 = YY / XX ;
             'FINSI' ;
             LEPSIEL1 = LEPSIEL1 'ET' ( 'PROG' XX ) ;
             LSIGIEL1 = LSIGIEL1 'ET' ( 'PROG' YY ) ;
          'FIN' BOUTRAC ;
          TRAIEL1 = 'EVOL' 'MANU' 'DEFO' LEPSIEL1 'CONT' LSIGIEL1 ;
          'SI' ( IMESS ) ;
             'MESS' '*** ELEMENT : ' IEL ' CHAMP : ' ITHER ' ***';
             'MESS' 'TMOY  : '    TMOY ;
             'MESS' 'YOUNG : ' YOUIEL1 ;
             'MESS' 'ALPHA : ' ALPIEL1 ;
             'MESS' 'RHO   : ' RHOIEL1 ;
             'MESS' 'NU    : '  NUIEL1 ;
             'MESS' 'COURBE DE TRACTION (SIGMA / EPSILON) : ' ;
             'LISTE' LSIGIEL1 ;'LISTE' LEPSIEL1 ;
          'FINSI' ;
          'SI' ( IEL 'EGA' 1 ) ;
             'SI' ( ITHER 'EGA' 1 ) ;
                MODTOT = 'MODL' IELEM1 'MECANIQUE' 'ELASTIQUE'
                         'PLASTIQUE' 'ISOTROPE'  NOMEL1 ;
                TABMAT.ITHER = 'MATR' MODTOT 'YOUN' YOUIEL1 'NU'
                 NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'TRAC' TRAIEL1 ;
             'SINON' ;
                TABMAT.ITHER = 'MATR' MODTOT 'YOUN' YOUIEL1 'NU'
                NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'TRAC' TRAIEL1 ;
             'FINSI' ;
          'SINON' ;
             'SI' ( ITHER 'EGA' 1 ) ;
                MODIEL1 = 'MODL' IELEM1 'MECANIQUE' 'ELASTIQUE'
                          'PLASTIQUE' 'ISOTROPE' NOMEL1 ;
                MODTOT = MODTOT 'ET' MODIEL1 ;
                MATIEL1 = 'MATR' MODIEL1 'YOUN' YOUIEL1 'NU' NUIEL1
                       'RHO' RHOIEL1 'ALPH' ALPIEL1 'TRAC' TRAIEL1 ;
                TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
             'SINON' ;
                MATIEL1 = 'MATR' MODIEL1 'YOUN' YOUIEL1 'NU'
                NUIEL1 'RHO' RHOIEL1 'ALPH' ALPIEL1 'TRAC' TRAIEL1 ;
                TABMAT.ITHER = TABMAT.ITHER 'ET' MATIEL1 ;
             'FINSI' ;
          'FINSI' ;
       'FIN' BOUCTHER ;
    'FIN' BOUCELEM ;
 'FIN' BOUTYPEL ;
 'SI' ( 'EXISTE' TABTEM 'PALIER' ) ;
    NTHERTOT = TABTEM.'NCHAMP' ;
    INUM = NTHER ;
    'REPETER' BOUCPAL (NTHERTOT - NTHER) ;
       INUM = INUM + 1 ;
       TABMAT.INUM = TABMAT.NTHER ;
       'SI' ( IMESS ) ;
          'MESS' 'OPTION PALIER : CREATION DE TABMAT.' INUM ;
       'FINSI' ;
    'FIN' BOUCPAL ;
 'FINSI' ;
 TEPMAT.'MODELE'   = MODTOT ;
 TEPMAT.'MATERIAU' = TABMAT ;
 'SI' ( IMESS ) ;
    'SAUTER' 1 'LIGNE' ;
    'MESS' '*** FIN DE MATHPLAS ***' ;
    'SAUTER' 1 'LIGNE' ;
 'FINSI' ;
*
 'FINPROC' TEPMAT ;
**** @MATLAB
DEBPROC @MATLAB EVO1*EVOLUTION  ;
ABSC1 = EXTR EVO1 ABSC   ;
N_COUR1 = DIME EVO1    ;
N_VALE1 = DIME ABSC1   ;




I1 = 1                   ;
REPETER BOUC1 N_VALE1        ;
 I2 = 1                       ;
 LLIST1 = EXTR ABSC1 I1 ;
 REPETER BOUC2 N_COUR1       ;
  VALEI2 = EXTR (EXTR EVO1 ORDO I2) I1  ;
  LLIST1 = CHAIN LLIST1 ' ' VALEI2           ;
  I2 = I2 + 1                       ;
 FIN BOUC2                    ;
 I1 = I1 + 1                ;
 MESS LLIST1            ;
FIN  BOUC1                      ;

FINPROC        ;
*-----------------------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*         1         2         3         4         5         6         7
*
*
*********************************************************************
*   PROCEDURE FRENET3D : CALCUL DU REPERE DE FRENET LE LONG D'UNE LIGNE
*          EN  3D
*********************************************************************
*
DEBPROC @FRENE3D LIG_1*MAILLAGE SURF_2/MAILLAGE VEC_1/POINT
                                        MOT_DIR/MOT LOG_1/LOGIQUE;
MESS '---------------------------------> entree dans FRENET3D';
V1 = VALEUR DIME ;
CH_T CH_N CH_B = FRENET LIG_1            ;
SI  (V1 > 2)                          ;
 A11 =  EXCO 'TX' CH_T 'P11' ;
 A12 =  EXCO 'TY' CH_T 'P12' ;
 A13 =  EXCO 'TZ' CH_T 'P13' ;
 A21 =  EXCO 'NX' CH_N 'P21' ;
 A22 =  EXCO 'NY' CH_N 'P22' ;
 A23 =  EXCO 'NZ' CH_N 'P23' ;
 A31 =  EXCO 'BX' CH_B 'P31' ;
 A32 =  EXCO 'BY' CH_B 'P32' ;
 A33 =  EXCO 'BZ' CH_B 'P33' ;
 CH_R = A11 ET A12 ET A13 ET
        A21 ET A22 ET A23 ET
        A31 ET A32 ET A33                     ;
SI ( NON ( EXISTE   LOG_1 )) ; LOG_1 = FAUX ; FINSI ;
 SI LOG_1                                            ;
  COX COY COZ  = COOR LIG_1 ;
  XMAX = MAXI COX ;
  YMAX = MAXI COY ;
  ZMAX = MAXI COZ ;
  XMIN = MINI COX ;
  YMIN = MINI COY ;
  ZMIN = MINI COZ ;
  DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  AMP = DL/10. ;
  VT = VECT CH_T AMP TX TY TZ ROUGE ;
  VN = VECT CH_N AMP NX NY NZ VERT ;
  VP = VECT CH_P AMP PX PY PZ BLEU ;
  TITRE 'REPERE DE FRENET DE LA LIGNE                 ' ;
  OEIL1 = (VEC_1 *100000.)  PLUS ( 5e4 5e4 5e4  )       ;
  TRAC QUAL OEIL1 (VT ET VN ET VP ) LIGN_1 ;
 FINSI ;
FINSI ;
*FINPROC  CH_R ;
SI  (V1 <EG 2)                          ;
 A11 =  EXCO 'TX' CH_T 'P11' ;
 A12 =  EXCO 'TY' CH_T 'P12' ;
 A21 =  EXCO 'NX' CH_N 'P21' ;
 A22 =  EXCO 'NY' CH_N 'P22' ;
 CH_R = A11 ET A12 ET  A21 ET A22 ;
 SI LOG_1                                            ;
  COX COY = COOR LIG_1 ;
  XMAX = MAXI COX ;
  YMAX = MAXI COY ;
  XMIN = MINI COX ;
  YMIN = MINI COY ;
  DL = (((XMAX - XMIN)**2) + ((YMAX -YMIN)**2))**0.5 ;
  AMP = DL/10. ;
  VT = VECT CHT AMP TX TY ROUGE ;
  VN = VECT CHN AMP NX NY VERT ;
  TITRE 'REPERE DE FRENET DE LA LIGNE                 ' ;
  TRAC QUAL (VT ET VN) LIGN_1 ;
 FINSI                                                 ;
FINSI                                                  ;
MESS '---------------------------------> sortie  de  FRENET3D';
FINPROC  CH_R ;

*-----------------------------------------------------------------------
*
*----------Fin de la procedure FRENET3D
*
*----------Debut de la procedure INDSCHL
*
*-----------------------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
************************************************************************
*    Organisation :
*    --------------
*    Une boucle sur les indices de la table entree teste s'ils sont reels
*    ou pas. Si l'indice est reel, on le stocke a la suite des autres
*    dans la liste des reels.

'DEBPROC' @INDSCHL TA_1*'TABLE   '                          ;
*
  TA_2 = INDE TA_1                                         ;
  P_1  = PROG                                              ;
  I1   =  0                                                ;
  REPETER BO_1 ( DIME TA_2 )                               ;
   I1   = I1 + 1                                           ;
   IND_1 = TA_2 . I1                                       ;
   TYP_1 = TYPE IND_1                                      ;
   SI ( EGA TYP_1 'FLOTTANT')                              ;
    P_1  = P_1 ET ( PROG IND_1 )                           ;
   SINON                                                   ;
    MESS '>>> TYPE DE L INDICE : ' TYP_1  'VALEUR :' IND_1  ;
    MESS '>>> ON NE FAIT RIEN '                            ;
   FINSI                                                   ;
  FIN  BO_1                                                ;
FINPROC   P_1                                              ;

*-----------------------------------------------------------------------
*
*----------Fin de la procedure @INDSCHL
*
*----------Debut de la procedure EPSCHL
*
*-----------------------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
************************************************************************

'DEBPROC' EPSCHL MOD_1*MMODEL  SI_13*MCHAML MAT_1/MCHAML
                   TE0*CHPOINT  TE1*CHPOINT  TAB1/'TABLE   '   ;
MESS '---------------------------------> entree dans EPSCHL';
*ENTREES TAB1.ZONE_MAT
*            .MODL_MAT .TETMAT .TEXTMECA .VIEW_P
*SORTIES     .MATTOT   .VIEW_P
*
SI (( NON ( EXISTE MAT_1)) ET   ( EXISTE TAB1))     ;
 I1   =  0                                 ;
 REPETER BOMA11                              ;
  I1 = I1 + 1                                   ;
  SI ( EXISTE (TAB1.ZONE_MAT)  I1 )                    ;
     MO1 = TAB1.MODL_MAT. I1                     ;
     TM_1 =    ( REDU TE1 TAB1.ZONE_MAT.I1  )                ;
     Y_1  = VARI  TM_1   TAB1.TETMAT.MO1.YOUN   YOUN    ;
     NU_1 = VARI  TM_1   TAB1.TETMAT.MO1.NU     NU     ;
     AL_1 = VARI  TM_1   TAB1.TETMAT.MO1.ALPH   ALPH     ;
     NU_1 = CHANGER CHAM NU_1 MO1 'RIGIDITE'                           ;
     Y_1  = CHANGER CHAM Y_1  MO1 'RIGIDITE'                           ;
     AL_1 = CHANGER CHAM AL_1 MO1 'RIGIDITE'                           ;
    TEX1     = TEXTE  'YOUN Y_1  NU  NU_1  ALPH AL_1'              ;
    IMOTM1               = DIME (MOTS  TAB1.TEXTMECA.I1)           ;
    SI ( IMOTM1   EGA 5  )                                        ;
     TEX1  =  TEXTE TEX1  'SIGY YM_1 '                           ;
     TITRE 'MAT' I1 ' YIELD MODULUS'             ;
     YM_1  =  VARI  TM_1   TAB1.TETMAT.MO1.SIGY     SIGY         ;
     YM_1  =  CHANGER CHAM YM_1  MO1 'RIGIDITE'                  ;
     TEX1     = TEXTE TEX1  'H H_1 '                        ;
     H_1 =  VARI  TM_1  TAB1.TETMAT.MO1.H    H              ;
     H_1 =  CHANGER CHAM H_1 MO1 'RIGIDITE'                 ;
   FINSI                                                    ;
   MA1  = MATR MO1 TEX1                                     ;
  SINON                                                      ;
   QUITTER BOMA11                                           ;
  FINSI                                                        ;
  SI ( I1 EGA 1 )                                              ;
   MOD_1 = MO1                                                 ;
   MAT_2 = MA1                                                 ;
  SINON                                                        ;
   MOD_1 = MOD_1 ET MO1                                        ;
   MAT_2 = MAT_2 ET MA1                                        ;
  FINSI                                                        ;
 FIN BOMA11                                                    ;
SINON                                                          ;
 MAT_2 = MAT_1                                                 ;
FINSI                                                          ;
  TAB1.MATTOT = MAT_2                                          ;
  SI_11    = THETA MOD_1  MAT_2     ( TE1 - TE0 )              ;
  FO1      = BSIGMA MOD_1 SI_11                                ;
  SI_12    = SI_13 + SI_11                                     ;
  EPS_1    = ELAS MOD_1 SI_12 MAT_2                            ;
* ici il faudrait extraire le alpha de mat_2
* multiplier par ( TE1 - TE0 ) et en faire un EPZZ
* a rajouter a EPS_1
  AL_P1    = EXCO 'ALPH' MAT_2 'SCAL'                           ;
  AL_P1    = CHAN 'TYPE' AL_P1  'DEFORMATIONS'                  ;
*  MAIL1    = EXTR AL_P1 'MAIL'                                   ;
   TCACH        = TEXT '    '                              ;
 SI ( NON (EXISTE TAB1 VIEW_P ))                          ;
   TAB1.VIEW_P = TEXT '    '                              ;
   TEX2        = TEXT '    '                              ;
   TCACH        = TEXT '    '                              ;
   SI ( EGA ( VALE DIME) 3 )                              ;
    TAB1.VIEW_P = 1.E8 1.E8 1.E8                          ;
    TCACH        = TEXT ' CACH '                              ;
   FINSI                                                  ;
 FINSI                                                      ;

*  OPTI TRAC X                                                   ;
*  TRAC  CACH TAB1.VIEW_P MAIL1
;
  TT_1     = CHAN 'CHAM' ( NOMC 'SCAL' ( TE1 - TE0 ))
                                        MOD_1 'RIGIDITE'        ;
  TT_1     = CHAN 'TYPE' TT_1  'DEFORMATIONS'                  ;
  TT_1     = ( AL_P1 * 0.) +  TT_1                            ;
*  MAIL2    = EXTR TT_1 'MAIL'                                   ;
*  TRAC  CACH TAB1.VIEW_P MAIL2                          ;
  E_ZZ1    =  AL_P1 *   TT_1                                    ;
  E_ZZ1    =  CHAN 'STRESSES' MOD_1 E_ZZ1                      ;
  E_ZZ1    = EXCO 'SCAL' E_ZZ1  'EPZZ'                           ;
  EPS_1    =  EPS_1 ET E_ZZ1                                   ;
MESS '---------------------------------> sortie  de  EPSCHL';
FINPROC   EPS_1                                                ;

*-----------------------------------------------------------------------
*
*----------Fin de la procedure EPSCHL
*
*----------Debut de la procedure MECASCH1
*
*ENTREES TAB1.ZONE_MAT
*             .MODL_MAT      .TETMAT         .TEXTMECA   .BLOCAGE
*             .CHPOTHETA     .DEFO_PLANE_GENE
*             .MAXITERATION  .L_BAS
*E/S          .VIEW_P      .LIS_ATRAITER     .MAXITERATION
*             .ITERATION   .CHA1             .VIEW_P2
*SORTIES      .MATTOT     .L_CONTOUR .PLASTIQUE .DEFO_PLANE_GENE
*             .S_TOTAL   .MODTOT     .MATTOT
*             .THERMIQUE .NZ
*-----------------------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
************************************************************************


'DEBPROC' MECASCH1 TAB1*'TABLE   '                         ;
MESS '---------------------------------> entree dans MECASCH1';
*OPTI ECHO 0                                                ;

V1 = VALEUR 'DIME'           ;
SI ( V1 EGA 2)                                           ;
 TFRONT1 = TEXT ' CONTOUR'                               ;
 TCACH = TEXT '    '                                     ;
SINON                                                    ;
 TFRONT1 = TEXT ' ENVELOP'                               ;
 TCACH =  TEXT ' CACH  '                                  ;
FINSI                                                    ;

SI ( NON (EXISTE TAB1 VIEW_P ))                             ;
 TAB1.VIEW_P = TEXT '    '                                  ;
 SI ( EGA ( VALE DIME) 3 )                                  ;
  TAB1.VIEW_P = 1.E8 1.E8 1.E8                              ;
 FINSI                                                      ;
FINSI                                                       ;

*SI  ( NON ( EXISTE TAB1  MECANIQUE ))   ;
*  TAB1.MECANIQUE = FAUX              ;
*  MESS ' >>>>>si vous voulez un calcul mecanique ' ;
*  MESS ' >>>>>faire TAB1.MECANIQUE = VRAI '         ;
*FINSI                              ;
*1
*SI ( TAB1.MECANIQUE   )                             ;
*  SI   ( NON ( EXISTE TAB1  CHPOTHETA ))   ;
*   TAB1.CHPOTHETA = TABLE                        ;
*  FINSI                                         ;
*  XI11 = 0.                                  ;
   SI   ( NON ( EXISTE TAB1  LIS_ATRAITER ))   ;
    TAB1. LIS_ATRAITER = @INDSCHL (TAB1.CHPOTHETA)            ;
   FINSI                                       ;
   LIS1 =  TAB1. LIS_ATRAITER                  ;
*   MESS '>>>> cas a traiter '                  ;
*   LIST LIS1                                   ;
*  SI  ( EXISTE TAB1 CHPT_INI )                 ;
*   TAB1.CHPOTHETA . 0.  = TAB1 . CHPT_INI      ;
*   LIS1 = PROG XI11                            ;
*  SINON                                        ;
*   XI11 = -1.                                  ;
*   LIS1 = PROG                                 ;
*  FINSI                                        ;
*  SI  ( EXISTE TAB1 CHPT_FINAL )                              ;
*    SI   ( NON ( EXISTE TAB1  CHPT_INI ) )                    ;
*      MESS '>>>> IL FALLAIT DONNER UN CHAMP INITIAL >>>>>'    ;
*      MESS '>>>> CELA VA SE PLANTER                 >>>>>'    ;
*    FINSI                                                     ;
*    XI11   = XI11 + 1.                                        ;
*    MESS '>>>>0.1 '                                           ;
*    LIS1 = LIS1 ET ( PROG XI11 )                              ;
*    TAB1.CHPOTHETA . XI11  = TAB1 . CHPT_FINAL                ;
*  FINSI                                                       ;
*  SI ( (TAB1 . PERMANENT) EGA VRAI ) ;
*   I11    = 0                                     ;
*   REPETER BOCAP1 ( DIME ( TAB1 . LIS_NO_ATRAITER)  )          ;
*    SI ( EXISTE TAB1 CHPT_FINAL ) ; QUITTER BOCAP1; FINSI     ;
*    XI11   = XI11 + 1.                                        ;
*    MESS '>>>>0.2 '                                           ;
*    I11    = I11 + 1                                      ;
*    I1     = EXTR TAB1.LIS_NO_ATRAITER I11                    ;
*    TAB1.CHPOTHETA .  XI11  =  TAB1.I1                       ;
*    LIS1 = LIS1 ET ( PROG XI11 )                              ;
*   FIN  BOCAP1                                                ;
*  FINSI                                                       ;
*  SI ( ( ((TAB1 . TRANSITOIRE) EGA VRAI ) ET
*                               (TAB1 . PERMANENT) EGA FAUX ) ) ;
*   REPETER BOCAT1                                   ;
*    SI ( EXISTE TAB1 CHPT_FINAL); QUITTER BOCAT1; FINSI   ;
*    XI11   = XI11 + 1.                                        ;
*    MESS '>>>>0.3 '                                           ;
*    I11    = ENTIER XI11                                      ;
*    SI ( NON ( EXISTE TAB1 I11  )); QUITTER BOCAT1; FINSI   ;
*    TAB1.CHPOTHETA .  XI11  =  TAB1. I11     ;
*    LIS1 = LIS1 ET ( PROG XI11 )                               ;
*   FIN  BOCAT1                                                 ;
*  FINSI                                                       ;
*
*  XF1  = PROG (DIME LIS1) *   1.                                   ;
*  F1   = FORCE FY 0. ( TAB1 . L_BAS )                        ;
*  CHA1   = CHAR F1  ( EVOL MANU LIS1 XF1 )    ;
  IPP1   =  0                                 ;
  REPETER BOMA10                              ;
    IPP1 = IPP1 + 1                                   ;
    SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                         ;
     SI ( IPP1 EGA 1 )                                         ;
      STOT1 = TAB1.ZONE_MAT . IPP1                             ;
      CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 )                 ;
     SINON                                                     ;
      STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1)                  ;
      CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1))      ;
     FINSI                                                     ;
    SINON                                                      ;
     QUITTER BOMA10                                           ;
    FINSI                                                      ;
  FIN  BOMA10                                                 ;
  TRAC  TCACH TAB1.VIEW_P CONTT1                              ;
  SI ( EXISTE TAB1 VIEW_P2 )                          ;
      TRAC  TCACH TAB1.VIEW_P2 CONTT1                              ;
  FINSI                                                      ;
  TAB1.L_CONTOUR  =   CONTT1                                 ;
  TAB1.S_TOTAL    =   STOT1                                    ;
* on calcule une temperature moyenne de l intervalle
CHP_TM1 = ( ((TAB1.CHPOTHETA .(EXTR 1 LIS1)) +
           (TAB1.CHPOTHETA .(EXTR (DIME LIS1)  LIS1)))  * 0.5 ) ;
TAB1.>CHP_TM1 = CHP_TM1 ;
@DEFMAT TAB1 ;
MOD_1 = TAB1.MODTOT;
MAT_1 = TAB1.MATTOT ;
 RIG_1 = RIGI MOD_1 MAT_1                          ;
 SI ( NON (EXISTE TAB1 PLASTIQUE  ))                          ;
   TAB1.PLASTIQUE   = VRAI                                   ;
 FINSI                                                      ;
 SI ( NON (EXISTE TAB1 DEFO_PLANE_GENE ))                          ;
   TAB1.DEFO_PLANE_GENE  = FAUX                                   ;
 FINSI                                                      ;


 MESS '>>>>>>> 2 >>>>>>'                                      ;
 SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE ))      ;
*  SI ( NON (EXISTE TAB1 PRECISION ))                          ;
*   TAB1.PRECISION   = 0.01                                   ;
*  FINSI                                                      ;
  MESS '>>>>>>> 2.1 >>>>>>'                                      ;
  SI ( NON ( EXISTE TAB1 MAXITERATION ) )                           ;
   TAB1.MAXITERATION = 100                                    ;
  FINSI                                                      ;
*  SI ( NON (EXISTE TAB1 ACCELERATION)  )                           ;
*   TAB1.ACCELERATION =  20                                    ;
*  FINSI                                                      ;
  TAB1.THERMIQUE = VRAI                         ;
  TAB1.ITERATION = KSI                          ;


SI (NON (EXISTE TAB1 CHA1))                          ;
 XF1  = PROG (DIME LIS1) *   1.                      ;
 F1   = FORCE FY 0. (TAB1 . L_BAS)                   ;
 CHARG1 = CHAR F1  ( EVOL MANU LIS1 XF1 )              ;
* TAB1.'CHA1' = CHA1 ;
SINON                                                ;
 CHARG1 = TAB1.'CHA1'                                  ;
FINSI                                                ;

  TAB1.NZ  = 0.;
*  TAB1.LIG1 = TAB1.L_BAS     ;
* TAB1.TINI = 150.     ;
*JS 19/10/94 je ne vois pas a quoi sert .TINI
* TAB1.TINI =     0.     ;
*  CHAI   = CHAR (TAB1 .CHARMECAFI)  ( EVOL MANU LIS1 XF1 )    ;
  MESS '>>>>>>>>DEBUT RIGIDITE '                  ;
  RIG10 = RIG_1 et ( TAB1 . BLOCAGE )         ;
*   CHAI   = CHAR (TAB1 .CHARMECAFI)  ( EVOL MANU LIS1 XF1 )  ;
  MESS '>>>>>>>>APPEL a NONLIN'                  ;
  NONLIN RIG10 MAT_1  CHARG1 LIS1 MOD_1   TAB1        ;
 FINSI                                                      ;
MESS '---------------------------------> sortie  de  MECASCH1';
FINPROC                     ;

*-----------------------------------------------------------------------
*
*----------Fin de la procedure MECASCH1
*
*----------Debut de la procedure MECASCH2
*
*-----------------------------------------------------------------------
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
************************************************************************

'DEBPROC' MECASCH2 TAB1*'TABLE   '                          ;

MESS '---------------------------------> entree dans MECASCH2';
 SI ( NON (EXISTE TAB1 LM_SIGCOMP ))                        ;
   TAB1.LM_SIGCOMP = MOTS  'VONM'                           ;
 FINSI                                                      ;
 SI ( NON (EXISTE TAB1 L_CASADEPOU ))                       ;
   TAB1.L_CASADEPOU = PROG (EXTR (DIME LIS1) LIS1)          ;
 FINSI                                                      ;
V1 = VALEUR 'DIME'                                          ;
SI ( NON (EXISTE TAB1 VIEW_P ))                             ;
 TAB1.VIEW_P = TEXT '    '                                  ;
 SI ( EGA ( VALE DIME) 3 )                                  ;
  TAB1.VIEW_P = 1.E8 1.E8 1.E8                              ;
 FINSI                                                      ;
FINSI                                                       ;

SI ( V1 EGA 2)                                           ;
 TFRONT1 = TEXT ' CONTOUR'                               ;
* modif mitteau
* TCACH = TEXT '    '                                     ;
 TCACH =  '    '                                     ;
SINON                                                    ;
 TFRONT1 = TEXT ' ENVELOP'                               ;
 TCACH =  ' CACH  '                                  ;
* TCACH = TEXT ' CACH  '                                  ;
FINSI                                                    ;

IPP1 = 0                                                      ;
REPETER BOMA10                                                ;
 IPP1 = IPP1 + 1                                              ;
 SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                           ;
  SI ( IPP1 EGA 1 )                                           ;
   STOT1 = TAB1.ZONE_MAT . IPP1                               ;
   CONTT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 )                   ;
   MOD_T1 = TAB1.MODL_MAT. IPP1                               ;
  SINON                                                       ;
   STOT1 = STOT1 ET (TAB1.ZONE_MAT . IPP1)                    ;
   CONTT1 = CONTT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1))        ;
   MOD_T1 = MOD_T1 ET TAB1.MODL_MAT. IPP1                     ;
  FINSI                                                       ;
 SINON                                                        ;
  QUITTER BOMA10                                              ;
 FINSI                                                        ;
FIN  BOMA10                                                   ;

TAB1.L_CONTOUR  =   CONTT1                                   ;
TAB1.S_TOTAL    =   STOT1                                    ;

SI ( NON (EXISTE TAB1 S_ADEPOU ))                             ;
 CONTT1 = TAB1.L_CONTOUR                                      ;
 STOT1 =  TAB1.S_TOTAL                                        ;
 MOTOT1 =  MOD_T1                                             ;
SINON                                                         ;
 STOT1 = TAB1.S_ADEPOU                                        ;
 MOTOT1 = TAB1.MO_ADEPOU                                      ;
 SI ( NON (EXISTE TAB1 C_ADEPOU ))                            ;
  CONTT1 = TFRONT1   TAB1.S_ADEPOU                            ;
 SINON                                                        ;
  CONTT1 =  TAB1.C_ADEPOU                                     ;
 FINSI                                                        ;
FINSI                                                         ;

 TAC8    =  TABLE                   ;
 TAC8.1  = 'NOLI '                  ;
 TAC8.2  = 'MARQ PLUS REGU'         ;
 TAC8.3  = 'MARQ ETOI REGU'         ;
 TAC8.4  = 'MARQ LOSA REGU'         ;
 TAC8.5  = 'MARQ CARR REGU'         ;
 TAC8.6  = 'MARQ TRIA REGU'         ;
 TAC8.7  = 'MARQ TRIB REGU'         ;
 TAC8.8  = 'MARQ PLUS REGU'         ;
 TAC8.9  = 'MARQ ETOI REGU'         ;
 TAC8.10 = 'MARQ CROI REGU'         ;

SI ( NON (EXISTE TAB1 LM_SIGCOMP ))                        ;
 TAB1.LM_SIGCOMP = MOTS  'VONM'                            ;
FINSI                                                      ;

SI ( NON (EXISTE TAB1 L_CASADEPOU ))                       ;
 TAB2 = INDE  TAB1.RESUDEPL                                ;
 MESS '>>>>>>ESSAI DIME DE TAB2' ( DIME TAB2 )             ;
 I1 = 0                                                    ;

 REPETER BINDE1                                            ;
  I1 = I1 + 1                                              ;
  SI (EXISTE TAB2 I1 )                                     ;
   XX2 = TAB2.I1                                        ;
  SINON                                                    ;
   QUITTER BINDE1                                    ;
  FINSI                                                    ;
 FIN BINDE1                                                ;

 TAB1.L_CASADEPOU  = PROG  XX2                             ;
FINSI                                                      ;

TCACH = TEXT '  '                                        ;
 SI ( EGA ( VALE DIME) 3 )                              ;
  TCACH = TEXT ' CACH  '                                ;
 FINSI                                                  ;

MOD_1 = TAB1.MODTOT                                        ;
MAT_1 = TAB1.MATTOT                                        ;
*
*JS 10/94 introduction option TAB1.TRAC_DEFOCONT
  SI( NON ( EXISTE TAB1 TRAC_DEFOCONT ))                    ;
   TAB1.TRAC_DEFOCONT = VRAI                                ;
  FINSI                                                     ;
  SI TAB1.TRAC_DEFOCONT ;
   MONMAIL = CONTT1     ;
  SINON                 ;
   MONMAIL = STOT1      ;
  FINSI                 ;
SI ( (TAB1.PLASTIQUE ) ET ( NON TAB1.DEFO_PLANE_GENE ))      ;
 MESS '>>>>>>> 3.1.0 >>>>>>'                                ;
 I1 = 0                                                   ;
 REPETER BDEPO1 ( DIME TAB1.L_CASADEPOU )                  ;
  I1 = I1 + 1                                              ;
  XIT1 = EXTR I1 TAB1.L_CASADEPOU                           ;
  VMI1 = VMIS MOD_1 TAB1.RESUCONT.XIT1                      ;
  SIRESU1 = ET TAB1.RESUCONT.XIT1  VMI1                    ;
  SIRESUA = ET TAB1.RESUVARI.XIT1  VMI1                    ;

  DEF0    =  DEFO  MONMAIL   TAB1.RESUDEPL.XIT1    0.           ;
  DEF5    =  DEFO  MONMAIL   TAB1.RESUDEPL.XIT1   20. ROUGE     ;
  TITRE 'TIME' XIT1 ' structure temperature'                ;
  MESS '>>>>>>> 3.1.1 >>>>>>'                               ;
  TMMM1 = MAXI (TAB1.'CHPOTHETA'.XIT1)  ;
  TMMI1 = MINI (TAB1.'CHPOTHETA'.XIT1)  ;
  DTMI1 = ABS (TMMM1 - TMMI1)           ;

  SI (EXISTE TAB1 TRAC_THERM) ;
   SI (TAB1.TRAC_THERM EGA VRAI )     ;
    SI( DTMI1 >EG 0.005 )                                    ;
* modif raph
*  MC_CHAM MC_MODL MC_MAIL = @CHAQT  MOTOT1 TAB1.'CHPOTHETA'.XIT1;
*  TRAC  TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL CONTT1;
*  SI ( EXISTE TAB1 VIEW_P2 )                           ;
*   MC_CHAM MC_MODL MC_MAIL = @CHAQT  MOTOT1 TAB1.'CHPOTHETA'.XIT1;
*   TRAC TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL CONTT1;
*  FINSI                                                 ;
    TRAC  TCACH TAB1.VIEW_P   TAB1.'CHPOTHETA'.XIT1 CONTT1 ;
     SI ( EXISTE TAB1 VIEW_P2 )                           ;
      TRAC TCACH TAB1.VIEW_P2 TAB1.'CHPOTHETA'.XIT1 CONTT1;
     FINSI                                                 ;

    FINSI                                                     ;
   FINSI                                                     ;
  FINSI                                                     ;

  TITRE 'TIME' XIT1 ' structure deformation'         ;
  MESS '>>>>>>> 3.1.3 >>>>>>'                        ;
* TRAC TCACH  TAB1.VIEW_P (ET DEF0 DEF5  )           ;
  TRAC CACH  TAB1.VIEW_P (ET DEF0 DEF5  )           ;
  SI ( EXISTE TAB1 VIEW_P2 )                         ;
*  TRAC  TCACH TAB1.VIEW_P2 ( ET DEF0  DEF5  )         ;
   TRAC  CACH TAB1.VIEW_P2 ( ET DEF0  DEF5  )         ;
  FINSI                                              ;

  I2 = 0                                             ;
  REPETER BDEPO2 ( DIME TAB1.LM_SIGCOMP)             ;
   I2 = I2 + 1                                       ;
   MOCOMP = EXTR TAB1.LM_SIGCOMP I2                  ;
   TITRE 'TIME' XIT1 MOCOMP ' STRESSES'              ;
   SI (( EGA MOCOMP 'VMIS') OU ( EGA MOCOMP 'VONM') );
    MOCOMP = 'SCAL'                                  ;
*             SINON                                  ;
*                  MC_CHAM MC_MODL MC_MAIL =
*                   @CHAQT MOTOT1 ( EXCO  SIRESUA MOCOMP );
*                 TRAC  CACH TAB1.VIEW_P MOD_1
*              MC_CHAM MC_MODL MC_MAIL CONTT1        ;
   FINSI                                             ;

   MESS '>>>>>>> 3.1.4 >>>>>>'                                 ;
   CHCONT1 = (REDU (EXCO SIRESU1 MOCOMP) MOTOT1)               ;

   SI ( EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19)             ;
    MESS 'Champs constant => on donne la valeur '              ;
    LIST  MOCOMP                                               ;
    LIST (MAXI CHCONT1)                                        ;
   SINON                                                       ;
    MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1             ;
    @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL
         STOT1 CONTT1      ;
   FINSI                                                       ;

   SI ( EXISTE TAB1 VIEW_P2 )                                  ;
    SI (EGA (MAXI CHCONT1) (MINI CHCONT1) 1.0E-19)             ;
     MESS 'Champs constant => on donne la valeur '             ;
     LIST  MOCOMP                                              ;
     LIST (MAXI CHCONT1)                                       ;
    SINON                                                      ;
     MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1 CHCONT1            ;
     @TRASCH TCACH TAB1.VIEW_P2 MC_CHAM MC_MODL MC_MAIL
         STOT1 CONTT1    ;
    FINSI                                                      ;
   FINSI                                                       ;

  FIN  BDEPO2                                                  ;
 FIN BDEPO1                                                    ;
 I3 = 0                                                        ;
 REPETER BDEPO3 ( DIME TAB1.L_CASADEPOU )                      ;
  I3 = I3 + 1                                              ;
  XIT1 = EXTR I3 TAB1.L_CASADEPOU                    ;
  DEPL_1 = TAB1.RESUDEPL.XIT1                    ;
  SI_1   = TAB1.RESUCONT.XIT1                   ;
* EPS_2  = TAB1.RESUDEFI.XIT1 + (ELAS MOD_1 SI_1 MAT_1)   ;
* MOD_1 = TAB1.MODTOT ;
  EPS_1   = EPSI MOD_1 DEPL_1                              ;
  EPS_1 =  EPS_1 ET ( EXCO EPSE TAB1.RESUVARI.XIT1)         ;
  I4 = 0                                                   ;
  REPETER BDEPO4 ( DIME TAB1.LM_EPSCOMP)                  ;
   I4 = I4 + 1        ;
   MOCOMP = EXTR TAB1.LM_EPSCOMP I4       ;
   TITRE 'TIME' XIT1 MOCOMP ' STRAINS' ;
   SI ( EGA MOCOMP 'EPSE')        ;
    TITRE 'TIME' XIT1 ' EPSE PLASTIC EQUIVALENT STRAINS ';

*  SINON               ;
*   MC_CHAM MC_MODL MC_MAIL  =
*   @CHAQT MOTOT1 ( EXCO EPS_2 MOCOMP );
*   TRAC CACH TAB1.VIEW_P MOD_1 MC_CHAM MC_MODL MC_MAIL
*                                  CONTT1;

   FINSI          ;

   SI (( EGA MOCOMP 'EPZZ') ET ( V1 EGA 2 )) ;
    EPS_3  = TAB1.RESUDEFI.XIT1 + (EPSCHL MOD_1 SI_1
     (TAB1.CHPOTHETA. 0.) (TAB1.CHPOTHETA.XIT1) TAB1 );
    TITRE 'TIME' XIT1 MOCOMP ' STRAINS'            ;
    MESS '>>>>>>> 3.1.5 >>>>>>'    ;
    MC_CHAM MC_MODL MC_MAIL =
    @CHAQT MOTOT1 ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
    @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL
                 STOT1 CONTT1  ;
    SI ( EXISTE TAB1 VIEW_P2 );
     MC_CHAM MC_MODL MC_MAIL = @CHAQT MOTOT1
     ( REDU ( EXCO EPS_3 MOCOMP ) MOTOT1 );
     @TRASCH  TCACH TAB1.VIEW_P2  MC_CHAM MC_MODL
            MC_MAIL STOT1 CONTT1;
    FINSI     ;
   SINON                                       ;
    MESS '>>>>>>> 3.1.6 >>>>>>'              ;
    SI ( EGA (MAXI ( ( REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1 )))
         (MINI ( ( REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1 ))) 1.0E-19) ;
     MESS 'Champs constant => on donne la valeur '  ;
     LIST  MOCOMP                              ;
     LIST (MAXI ( ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 )));
    SINON             ;
     MC_CHAM MC_MODL MC_MAIL =
             @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 );
     @TRASCH TCACH TAB1.VIEW_P MC_CHAM MC_MODL MC_MAIL
                                           STOT1 CONTT1   ;
    FINSI                                                             ;
    SI ( EXISTE TAB1 VIEW_P2 )                                    ;
     SI ( EGA (MAXI (REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1))
              (MINI (REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1)) 1.0E-19) ;
          MESS 'Champs constant => on donne la valeur '            ;
          LIST MOCOMP                                              ;
          LIST (MAXI ( ( REDU ( EXCO  EPS_1 MOCOMP ) MOTOT1 )))    ;
     SINON                                                         ;
          MC_CHAM MC_MODL MC_MAIL =
                @CHAQT MOTOT1 ( REDU ( EXCO EPS_1 MOCOMP ) MOTOT1 ) ;
          @TRASCH  TCACH TAB1.VIEW_P2  MC_CHAM MC_MODL
                        MC_MAIL STOT1 CONTT1;
     FINSI                                                  ;
    FINSI                                                       ;
   FINSI                                          ;
  FIN  BDEPO4                                        ;
 FIN BDEPO3                                             ;
*              DEPOMIMA TAB1                  ;
FINSI                                                       ;
MESS '---------------------------------> sortie  de  MECASH2';
FINPROC                                                      ;
**** @OMBJET

DEBPROC @OMBJET TAB1*TABLE ;
*
***************************************************
* PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
* PROCEDURES POUR REMONTER LES LIGNES DE CHAMP    *
* SELON LA METHODE CHOISIE.                       *
*          (VERSION DE @OMBRAGE POUR JET)         *
***************************************************
* Modif :                                         *
* 09/11/01 (A.MOAL) : sens de remontee selon le   *
*                     signe de dpsi               *
* 23/11/01 (A.MOAL) : suppression du sens de      *
*                     remontee suivant le signe   *
*                     de dpsi                     *
* 23/11/01 (A.MOAL) : possibilite d'imposer le    *
*                     sens de remontee            *
***************************************************
*
MESS '---------------------------------> calling @OMBJET';

*--- VARIABLES D'ENTREE :

MAIL1   = TAB1.<S_OMBRE ;
VMAIL1  = TAB1.<V_OMBRE_N;
GMAIL1  = TAB1.<S_OMBRE_N;

MAIL2   = TAB1.<S_OMBRANT ;
VMAIL2  = TAB1.<V_OMBRANT_N;
GMAIL2  = TAB1.<S_OMBRANT_N;
IMETHOD = TAB1.<METHODE_REMONTEE ;

SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
 REPO    = TAB1.<SAUV_PTS_OMBRANTS ;
SINON ;
 REPO = FAUX ;
FINSI ;

si (non (exis tab1 <reprise)) ;
 tab1.<reprise = faux ;
finsi ;

* --- distance de remontee precedente en cas de reprise
si (tab1.<reprise) ;
 d_prec = tab1.<LONGUEUR_REMONTEE ;
sinon ;
 d_prec = 0. ;
finsi ;

DMAX2   = TAB1.<DIST_AVEC_TEST             ;
PASB2   = TAB1.<PAS_AVEC_TEST            ;

REPV    = EXIS TAB1 <DIST_SANS_TEST ;
SI REPV ;
 DMAX1   = TAB1.<DIST_SANS_TEST  ;
 PASB1   = TAB1.<PAS_SANS_TEST           ;
FINSI ;
*
* --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
*
si (non (tab1.<reprise));
* --- VARIABLES D'ENTREE, Valeurs par defaut
*
 @VDEFJET TAB1 ;

SENS0 = TAB1.<SENS_REMONTEE ;
*
* ----
 MESS '>@OMBJET> Construction du champoint B scalaire N';
*
*---- lecture de la carte de champ magnetique dans un fichier
@LECTB TAB1 ;
TITRE '@OMBJET : MAGNETIC DOMAIN, STUDIED AND SHADING OBJECT';
*TRAC (TAB1.<GRILLE_B ET MAIL2 ET MAIL1) ;
TRAC ((ENVE TAB1.<GRILLE_B) ET (ENVE MAIL2) ET (ENVE MAIL1)) ;

* ---- Calcul du champ dans le repere global

* ---- coordonnees dans le repere du maillage
 XM0 = COOR 1 GMAIL1 ;
 YM0 = COOR 2 GMAIL1 ;
 DIM0 = VALEUR DIME ;
 SI (DIM0 EGA 2) ;
  ZM0 = XM0 * 0. ;
  BNUL =  XM0 * 0. ;
 SINON ;
  ZM0 = COOR 3 GMAIL1 ;
 FINSI ;

*---- Coordonnees dans le repere global du
*---- tore (pas de changement de repere)
 XG_OLD = XM0 ;
 YG_OLD = YM0 ;
 ZG_OLD = ZM0 ;

TAB1.<MAILLAGE_B = MAIL1 ;
BR BZ BPHI = @MAGNB TAB1 ;

*---- composantes de B dans le repere du maillage
PHI = ATG (COOR 2 MAIL1) (COOR 1 MAIL1) ;
*AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
BXM = BR * (COS PHI) - (BPHI * (SIN PHI));
BYM = BR * (SIN PHI) + (BPHI * (COS PHI));
BZM = BZ ;
MENAGE ;
*
*---- calcul des normales a la surface calculees
*---- dans le repere du maillage
 si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  tab1.<nxm = NXM ;
  tab1.<nym = NYM ;
  tab1.<nzm = NZM ;
 sinon ;
  NXM = tab1.<nxm ;
  NYM = tab1.<nym ;
  NZM = tab1.<nzm ;
 finsi ;

*---- calcul du produit scalaire
 PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);
 CHSIGN0 = PVBVN / (ABS PVBVN) ;

SI (SENS0 NEG 0) ;
*  ---- possibilite d'imposer le sens de remontee des lignes
*  ---- sans tenir compte du critere sur b.n
   CHSIGN0 = (ABS CHSIGN0) * SENS0 ;
FINSI ;

*---- debut modif (09/11/01 - A.Moal)
*---- mise en commentaire des modifs le 23/11/01 - A.Moal
* l'idee abandonnee était :
* Si SENS0 = 0 alors on remonte les lignes de champ avec
* pour seul critere le sens de la normale sortante.
* Si SENS0 = 1, on remonte dans le sens de B lorsque dpsi
* est positif et dans le sens de -B lorsque dpsi est
* negatif à condition que ce soit dans le sens de
* la normale sortante (sinon la ligne n'est pas
* remontee pour le point considere).
* Si SENS0 = - 1, on remonte dans le sens de B lorsque
* dpsi est negatif et dans le sens de -B lorsque
* dpsi est positif à condition que ce soit dans le
* sens de la normale sortante (sinon la ligne n'est
* pas remontee pour le point considere).
*SI (SENS0 NEG 0) ;
*  ---- on definit un sens de remontee en fonction de dpsi
*   CHDPSI = @DPSI TAB1 ;
*   SIGDPSI = CHDPSI * SENS0 / (ABS CHDPSI) ;
*   TITRE '@OMBJET : DPSI ON THE SHADOWED MESH' ;
*   TRAC CHDPSI MAIL1 ;
*   TITRE '@OMBJET : SIGN OF DPSI ON THE SHADOWED MESH' ;
*   TRAC SIGDPSI MAIL1 ;
*  ----- on ne remonte que les points dont le sens de remontee
*  ----- impose par <SENS_REMONTEE est le meme qu'avec le critere de
*  ----- la normale sortante (CHSIGN0 = 0. pour les autres points)
*   CHSIGN0 = CHSIGN0 * ((CHSIGN0 * SIGDPSI) MASQUE SUPERIEUR 0.);
*FINSI ;
*VB1 = @CVECT (BXM*CHSIGN0) (BYM*CHSIGN0) (BZM*CHSIGN0)
*                TAB1.LFLUX_EXTE VERT;
*TITRE '@OMBJET : DIRECTION FOR COMING UP THE MAGNETIC LINES' ;
*TRAC VB1 MAIL1 ;
*---- fin mise en commentaire
*---- fin modif

*---- PROJECTION SUR LE MAILLAGE FIN INITIAL
*---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
 MAILPT = CHAN MAIL1 POI1 ;
 NBNFIN = NBNO MAIL1 ;
 PT1 = ELEM MAILPT POINT 1 ;
 PP = GMAIL1 POIN PROC PT1 ;
 VAL1 = EXTR CHSIGN0 SCAL PP ;
 MAILP1 = MANU POI1 PT1 ;
 CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
 REPETER BOUPI (NBNFIN - 1) ;
  I = &BOUPI + 1 ;
  PTI = ELEM MAILPT POINT I ;
  PPI = GMAIL1 POIN PROC PTI ;
  VALI = EXTR CHSIGN0 SCAL PPI ;
  MAILPI = MANU POI1 PTI ;
  CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  CHSIGN1 = CHSIGN1 ET CHI ;
 FIN BOUPI ;

*---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
*---- les lignes de champ
 si (exis tab1 <remontee) ;
  NPTS = DIME tab1 . <remontee . <point ;
  REPETER BOUPTS1 NPTS ;
   pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
   PP1 = MAIL1 POIN PROC PT1 ;
   MAILP1 = MANU POI1 PT1 ;
   VAL1 = EXTR CHSIGN1 SCAL PP1 ;
   CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
   CHSIGN1 = CHSIGN1 ET CH1 ;
  FIN BOUPTS1 ;
 finsi ;

 TAB1.<CHSIGN = CHSIGN1  ;
finsi ;

* === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
* RM310898 ruse pour ne pas avoir de pb avec les parties entieres
* apres constat comportement erratique

nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
TAB1.<NBPAS2 = NBPAS2 ;
DMAX0 = (NBPAS2 * PASB2) + d_prec ;

si (exis tab1 <DIST_SANS_TEST) ;
 nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
 TAB1.<NBPAS1 = NBPAS1 ;
 DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
finsi ;

*
* --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
*
SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
   TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
FINSI ;

*
* --- Appel de la procedure utiliant la methode analytique
*
SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
   @ANAJET TAB1 ;
*  ---- on retrouve la forme initiale
   FORM (TAB1.<DEPLACE * (-1.)) ;
FINSI ;
*


* --- Appel de la procedure utiliant la methode geometrique
*
SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
   CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
   TAB1.<CHDIST   =  CHDIST0;
   TAB1.<MAI1TRAV =  MAI1TRAV           ;
FINSI ;

MESS '>@OMBJET> - execution correcte' ;
MESS '>@OMBJET> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;

SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
   MESS ' ' ;
   MESS '>@OMBJET> Pas d ombrage de OMBRE par OMBRANT';
   MESS ' ' ;
SINON;
 MESS '>@OMBJET> mini - maxi de la longueur de connection'
  (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
FINSI;

SI REPO                              ;
    TAB1.<P_OMBRANTS    =  POMB            ;
FINSI                                ;
*  --------------- VARIABLES DE SORTIE GENERALES :
   TAB1.<MASQOMB  =  MASQ TAB1.<CHDIST EGSUPE
                    (DMAX0 - (PASB2/1000.)) ;
*------------------------------------

*
MESS '---------------------------------> exiting @OMBJET';
FINPROC ;
**** @OMBRAGE
DEBPROC @OMBRAGE TAB1*TABLE ;
*
***************************************************
* PROGRAMME CASTEM GERANT L'APPEL AUX DIFFERENTES *
* PROCEDURES POUR REMONTER LES LIGNES DE CHAMP    *
* SELON LA METHODE CHOISIE                        *
***************************************************
*
MESS '---------------------------------> calling @OMBRAGE';

*--- VARIABLES D'ENTREE :

MAIL1   = TAB1.<S_OMBRE ;
VMAIL1  = TAB1.<V_OMBRE_N;
GMAIL1  = TAB1.<S_OMBRE_N;

MAIL2   = TAB1.<S_OMBRANT ;
VMAIL2  = TAB1.<V_OMBRANT_N;
GMAIL2  = TAB1.<S_OMBRANT_N;
IMETHOD = TAB1.<METHODE_REMONTEE           ;

RP      = TAB1.<RP ;
HP      = TAB1.<HP ;

SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
 REPO    = TAB1.<SAUV_PTS_OMBRANTS             ;
SINON ;
 REPO = FAUX ;
FINSI ;

si (non (exis tab1 <reprise)) ;
 tab1.<reprise = faux ;
finsi ;


* forcage du sens de remontee des linges de champ
* voir commentaire plus loin ou la notice
si (exis tab1 <chsignr1) ;
 chsignr1 = tab1.<chsignr1 ;
finsi ;
*
* ------ verification de l'appartenance du maillage ombre ---------
* --------------- au domaine de validite de TOKAFLU ---------------
xm ym zm = coor mail1 ;
xg yg zg = @crmgc xm ym zm tab1 ;
rho theta phi = @crgtc xg yg zg rp hp ;
rhomax = maxi rho ;
rhomin = mini rho ;
thetamax = maxi theta ;
thetamin = mini theta ;
* RM 22/12/98 je desactive le test sur les angles
*si ((rhomax > 1.1)    ou (rhomin < 0.4) ou
*    (thetamax > 110.) ou (thetamin < -110.)) ;

si ((rhomax > 1.1)    ou (rhomin < 0.4)) ;
 ERRE ' >>>> @OMBRAGE : Le maillage ombre n est pas inclus
 dans le domaine de validite des modeles de @TOKAFLU';
finsi ;


* --- distance de remontee precedente en cas de reprise
si (tab1.<reprise) ;
 d_prec = tab1.<LONGUEUR_REMONTEE ;
sinon ;
 d_prec = 0. ;
finsi ;

DMAX2   = TAB1.<DIST_AVEC_TEST             ;
PASB2   = TAB1.<PAS_AVEC_TEST            ;

REPV    = EXIS TAB1 <DIST_SANS_TEST ;
SI REPV ;
 DMAX1   = TAB1.<DIST_SANS_TEST  ;
 PASB1   = TAB1.<PAS_SANS_TEST           ;
FINSI ;
*
* --- Si le calcul est une reprise, on ne re-calcule pas CHSIGN1
*
si (non (tab1.<reprise));
* --- VARIABLES D'ENTREE, Valeurs par defaut
*
 @VDEFAUT TAB1 ;
*
* ----
 MESS '>@OMBRAGE> Construction du champoint B scalaire N';
*


* ---- Calcul du champ dans le repere global

* ---- coordonnees dans le repere du maillage
 XM0 = COOR 1 GMAIL1 ;
 YM0 = COOR 2 GMAIL1 ;
 DIM0 = VALEUR DIME ;
 SI (DIM0 EGA 2) ;
  ZM0 = XM0 * 0. ;
  BNUL =  XM0 * 0. ;
 SINON ;
  ZM0 = COOR 3 GMAIL1 ;
 FINSI ;


*---- Coordonnees dans le repere global du tore
 XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;


*
 TYPCAL  = TAB1.<TYPE_CALCUL ;
 SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
  ISHIFT = VRAI ;
  IRIPPLE = VRAI ;
 FINSI ;
 SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
  ISHIFT = VRAI ;
  IRIPPLE = FAUX ;
 FINSI ;
 SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
  ISHIFT = FAUX ;
  IRIPPLE = VRAI ;
 FINSI ;
 SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
  ISHIFT = FAUX ;
  IRIPPLE = FAUX ;
 FINSI ;
 SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
  ERRE '>@OMBRAGE> : check the value of TAB1.<TYPE_CALCUL';
 FINSI ;


 BXG BYG BZG FSECU = @CHAMB TAB1 XG_OLD YG_OLD
                        ZG_OLD ISHIFT IRIPPLE ;
*---- composantes de B dans le repere du maillage
 BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
*
*---- calcul des normales a la surface calculees
*---- dans le repere du maillage
 si ((non (exis tab1 <nxm)) et ((nbno GMAIL1) ega (nbno MAIL1)));
  MESS 'APPEL DE VNORM3D POUR LE MAILLAGE OMBRE';
  NXM NYM NZM = @VNORM3D VMAIL1 GMAIL1 ;
  tab1.<nxm = NXM ;
  tab1.<nym = NYM ;
  tab1.<nzm = NZM ;
 sinon ;
  NXM = tab1.<nxm ;
  NYM = tab1.<nym ;
  NZM = tab1.<nzm ;
 finsi ;

*---- calcul du produit scalaire
 PVBVN = (BXM*NXM) + (BYM*NYM) + (BZM*NZM);

 CHSIGN0 = PVBVN / (ABS PVBVN) ;

*---- PROJECTION SUR LE MAILLAGE FIN INITIAL
*---- BOUCLE SUR CHAQUE POINT DU MAILLAGE FIN
 MAILPT = CHAN MAIL1 POI1 ;
 NBNFIN = NBNO MAIL1 ;
 PT1 = ELEM MAILPT POINT 1 ;
 PP = GMAIL1 POIN PROC PT1 ;
 VAL1 = EXTR CHSIGN0 SCAL PP ;
 MAILP1 = MANU POI1 PT1 ;
 CHSIGN1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
 REPETER BOUPI (NBNFIN - 1) ;
  I = &BOUPI + 1 ;
  PTI = ELEM MAILPT POINT I ;
  PPI = GMAIL1 POIN PROC PTI ;
  VALI = EXTR CHSIGN0 SCAL PPI ;
  MAILPI = MANU POI1 PTI ;
  CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DIFFUS ;
  CHSIGN1 = CHSIGN1 ET CHI ;
 FIN BOUPI ;

*---- Complement de TAB1.<CHSIGN1 sur les noeuds dont on veut remonter
*---- les lignes de champ
* ajout R. Mitteau le 13 mars 2001
* possibilite de definir soi-meme le chsign pour les noeuds
* dont on veut suivre la trajectoire
* on defini un tab1.chsign2, qu'on prend si il existe
 si (exis tab1 <remontee) ;comm debut si sur point a remonter ;
  si (exis tab1 <chsignr1) ;
   chsign1 = chsign1 et chsignr1 ;
  sinon ;
   NPTS = DIME tab1 . <remontee . <point ;
   REPETER BOUPTS1 NPTS ;
    pt1 = tab1 . <remontee . <point . &BOUPTS1 ;
    PP1 = MAIL1 POIN PROC PT1 ;
    MAILP1 = MANU POI1 PT1 ;
    VAL1 = EXTR CHSIGN1 SCAL PP1 ;
    CH1 = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DIFFUS ;
    CHSIGN1 = CHSIGN1 ET CH1 ;
   FIN BOUPTS1 ;
  finsi ;
 finsi ;comm fin si sur point a remonter ;
 TAB1.<CHSIGN = CHSIGN1  ;
finsi ; comm refere au non tab1 reprise ;

* === NOMBRE DE PAS MAXIMUM A EFFECTUER PAR LA PROCEDURE
* RM310898 ruse pour ne pas avoir de pb avec les parties entieres
* apres constat comportement erratique

nbpas2 = ENTIER ((DMAX2 + (PASB2/1000.))/PASB2) ;
TAB1.<NBPAS2 = NBPAS2 ;
DMAX0 = (NBPAS2 * PASB2) + d_prec ;

si (exis tab1 <DIST_SANS_TEST) ;
 nbpas1 = ENTIER ((DMAX1 + (PASB1/1000.))/PASB1) ;
 TAB1.<NBPAS1 = NBPAS1 ;
 DMAX0 = (NBPAS1 * PASB1) + (NBPAS2 * PASB2) + d_prec ;
finsi ;

*
* --- Choix du test d'intersection ANALYTIQUE (par defaut) ou GEOMETRIQUE
*
SI (NON (EXIS TAB1 <METHODE_INTERSECTION)) ;
   TAB1.<METHODE_INTERSECTION = ANALYTIQUE ;
FINSI ;

*
* --- Appel de la procedure utiliant la methode analytique
*
SI (EGA TAB1.<METHODE_INTERSECTION ANALYTIQUE) ;
   @ANALY TAB1 ;
FINSI ;
*


* --- Appel de la procedure utiliant la methode geometrique
*
SI (EGA TAB1.<METHODE_INTERSECTION GEOMETRIQUE) ;
   CHDIST0 MAI1TRAV POMB = @TESTGEO TAB1 ;
   TAB1.<CHDIST   =  CHDIST0;
   TAB1.<MAI1TRAV =  MAI1TRAV           ;
FINSI ;

MESS '>@OMBRAG> - execution correcte' ;
MESS '>@OMBRAG> remontee en metre :' TAB1.<LONGUEUR_REMONTEE ;

SI (EGA (TAB1.<CONNEXION_MAX) 0.) ;
   MESS ' ' ;
   MESS '>@OMBRAGE> Pas d ombrage de OMBRE par OMBRANT';
   MESS ' ' ;
SINON;
 MESS '>@OMBRAG> mini - maxi de la longueur de connection'
  (mini TAB1.<CHDIST) TAB1.<CONNEXION_MAX ;
FINSI;

SI REPO                              ;
    TAB1.<P_OMBRANTS    =  POMB            ;
FINSI                                ;
*  --------------- VARIABLES DE SORTIE GENERALES :
   TAB1.<MASQOMB  =  MASQ TAB1.<CHDIST EGSUPE
                    (DMAX0 - (PASB2/1000.)) ;
*------------------------------------

*
MESS '---------------------------------> exiting @OMBRAGE';
FINPROC ;
***** OPIE
*********************************************************
******              PROCEDURE IPOE                ******
*********************************************************
* INTERPOLATION EN UTILISANT UNE EVOLUTION
*--------------------------------------------------------
DEBPROC  OPIE  OBJ_11/FLOTTANT  OBJ_12/LISTREEL    OBJ_13/CHPOINT
               EVO_1*EVOLUTION  MO_1/MOT                      ;
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1          2        3          4         5         6        7

LR_1 = EXTR  EVO_1 'ABSC'  1                                 ;
LR_2 = EXTR  EVO_1 'ORDO'  1                                 ;
IS1 = DIME LR_2                                              ;
LR_2B = ENLE LR_2 1                                          ;
LR_2A = ENLE LR_2 IS1                                        ;
IA1 = ( (LR_2B - LR_2A)  MASQUE 'EGSUPE' 'SOMME' 0.)         ;
II1 = ( (LR_2B - LR_2A)  MASQUE 'EGINFE' 'SOMME' 0.)         ;
IS2 = IS1 - 1                                                ;
SI ( IA1 EGA IS2 )                                           ;
 LRE_2 = LR_1                                                ;
 LRE_1 = LR_2                                                ;
 A_1  = 1.                                                   ;
SINON                                                        ;
 SI ( II1 EGA IS2 )                                          ;
  A_1 = -1.                                                  ;
  LRE_2 = LR_1                                               ;
  LRE_1 = LR_2  * A_1                                        ;
 SINON                                                       ;
  MESS '>>>OPIE sorry your EVOL is not monotonous'           ;
  ERREUR '>>>OPIE sorry your EVOL is not monotonous'         ;
 FINSI                                                       ;
FINSI                                                        ;
SI ( NON (EXISTE MO_1))                                       ;
 MO_2 = MOT 'SANS'                                            ;
SINON                                                         ;
 MO_2 = MO_1                                            ;
FINSI                                                          ;
SI (( EGA MO_2 'LINE' ) OU ( EGA MO_2 'FIXE' ))                  ;
 SI ( EXISTE  OBJ_11 )                                         ;
  OBJ_2 = ITPLT  LRE_1  LRE_2  MO_2  (OBJ_11 * A_1)          ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_12 )                                         ;
  OBJ_2 = ITPLT  LRE_1  LRE_2  MO_2  (OBJ_12 * A_1)          ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_13 )                                         ;
  OBJ_2 = ITPLT  LRE_1  LRE_2  MO_2  (OBJ_13  * A_1)           ;
 FINSI                                                         ;
SINON                                                         ;
 SI ( EXISTE  OBJ_11 )                                         ;
  OBJ_2 = IPOL  (OBJ_11 * A_1) LRE_1  LRE_2               ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_12 )                                         ;
  OBJ_2 = IPOL  (OBJ_12 * A_1) LRE_1  LRE_2              ;
 FINSI                                                         ;
 SI ( EXISTE  OBJ_13 )                                         ;
  OBJ_2 = IPOL  (OBJ_13  * A_1) LRE_1  LRE_2            ;
 FINSI                                                         ;
FINSI                                                          ;
FINPROC  OBJ_2                                                 ;
*--------------------------------------------------------------------
**** ORTHO1
********************
* PROCEDURE ORTHO1 *
********************

DEBPROC ORTHO1 GEO1*MAILLAGE LIG1*MAILLAGE
               CH1*CHPOINT CH2*CHPOINT
               ALPHA*FLOTTANT
               LL*LISTREEL TYPEMAT*MOT TYPEELEM*LISTMOTS;

GEO = CHAN POI1 GEO1;
NEL1 = NBNO GEO;
DIMGEO = VALEUR DIME;
YOUNG11 = EXTR LL 1;
YOUNG22 = EXTR LL 2;
YOUNG33 = EXTR LL 3;
NU11 = EXTR LL 4;
NU22 = EXTR LL 5;
NU33 = EXTR LL 6;
CIS11 = EXTR LL 7;
CIS22 = EXTR LL 8;
CIS33 = EXTR LL 9;
ALPH11 = EXTR LL 10;
ALPH21 = EXTR LL 11;
ALPH31 = EXTR LL 12;
RHO = EXTR LL 13;

L1 = EXTR CH1 'COMP';
L2 = EXTR CH2 'COMP';

NBTYPE = DIME TYPEELEM;
NBCOMP = 0;
REPETER BOUCLNB NBTYPE;
 NBCOMP = NBCOMP + 1;
 TYPEN = EXTR TYPEELEM NBCOMP;
 MODLNB = MODL GEO1 MECANIQUE ELASTIQUE ORTHOTROPE TYPEN ;
 SI (NBCOMP EGA 1);
  MODL1 = MODLNB;
 SINON;
  MODL1 = MODL1 ET MODLNB;
 FINSI;
FIN BOUCLNB;

SI (DIMGEO EGA 3);
 COMP = 0;
 L11 = EXTR 1 L1;
 L12 = EXTR 2 L1;
 L13 = EXTR 3 L1;
 L21 = EXTR 1 L2;
 L22 = EXTR 2 L2;
 L23 = EXTR 3 L2;
 REPETER BOUCL1 NEL1;
  COMP = COMP + 1;
  POINMAIL = GEO POIN COMP;
  POINCOUR = LIG1 POIN PROC POINMAIL;
  CH1MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH1 L11 POINCOUR)
                                 KY (EXTR CH1 L12 POINCOUR)
                                 KZ (EXTR CH1 L13 POINCOUR);
  CH2MAIL = MANU CHPO POINMAIL 3 KX (EXTR CH2 L21 POINCOUR)
                                 KY (EXTR CH2 L22 POINCOUR)
                                 KZ (EXTR CH2 L23 POINCOUR);
  SI (COMP EGA 1);
   CH1GEO = CH1MAIL;
   CH2GEO = CH2MAIL;
  SINON;
   CH1GEO = CH1GEO ET CH1MAIL;
   CH2GEO = CH2GEO ET CH2MAIL;
  FINSI;
 FIN BOUCL1;

 CH1 = ((COS ALPHA)*CH1GEO) + ((SIN ALPHA)*CH2GEO);
 CH2 = (((-1.*(SIN ALPHA))*CH1GEO)) + ((COS ALPHA)*CH2GEO);

 CHNEUTRE = (COOR 1 GEO1);
 VRX = NOMC V1X (EXCO KX CH1);
 VRY = NOMC V1Y (EXCO KY CH1);
 VRZ = NOMC V1Z (EXCO KZ CH1);
 VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
 VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
 VRZ1 = CHAN CHAM VRZ MODL1 RIGIDITE;
 VZX = NOMC V2X (EXCO KX CH2);
 VZY = NOMC V2Y (EXCO KY CH2);
 VZZ = NOMC V2Z (EXCO KZ CH2);
 VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
 VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;
 VZZ1 = CHAN CHAM VZZ MODL1 RIGIDITE;
SINON;
 COMP = 0;
 L11 = EXTR 1 L1;
 L12 = EXTR 2 L1;
 L21 = EXTR 1 L2;
 L22 = EXTR 2 L2;
 REPETER BOUCL1 NEL1;
  COMP = COMP + 1;
  POINMAIL = GEO POIN COMP;
  POINCOUR = LIG1 POIN PROC POINMAIL;
  CH1MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH1 L11 POINCOUR)
                                 KY (EXTR CH1 L12 POINCOUR);
  CH2MAIL = MANU CHPO POINMAIL 2 KX (EXTR CH2 L21 POINCOUR)
                                 KY (EXTR CH2 L22 POINCOUR);
  SI (COMP EGA 1);
   CH1GEO = CH1MAIL;
   CH2GEO = CH2MAIL;
  SINON;
   CH1GEO = CH1GEO ET CH1MAIL;
   CH2GEO = CH2GEO ET CH2MAIL;
  FINSI;
 FIN BOUCL1;

 CH1 = (CH1GEO*(COS ALPHA)) + (CH2GEO*(SIN ALPHA));
 CH2 = ((CH1GEO*(-1.*(SIN ALPHA)))) + (CH2GEO*(COS ALPHA));

 CHNEUTRE = (COOR 1 GEO1);
 VRX = NOMC V1X (EXCO KX CH1);
 VRY = NOMC V1Y (EXCO KY CH1);
 VRX1 = CHAN CHAM VRX MODL1 RIGIDITE;
 VRY1 = CHAN CHAM VRY MODL1 RIGIDITE;
 VZX = NOMC V2X (EXCO KX CH2);
 VZY = NOMC V2Y (EXCO KY CH2);
 VZX1 = CHAN CHAM VZX MODL1 RIGIDITE;
 VZY1 = CHAN CHAM VZY MODL1 RIGIDITE;

FINSI;

YOUNGR = ( CHNEUTRE * 0.) + YOUNG11;
YOUNGZ = ( CHNEUTRE * 0.) + YOUNG22;
YOUNGT = ( CHNEUTRE * 0.) + YOUNG33;
NURZ = ( CHNEUTRE * 0.) + NU11;
NUZT = ( CHNEUTRE * 0.) + NU22;
NURT = ( CHNEUTRE * 0.) + NU33;
CISRZ = ( CHNEUTRE * 0.) + CIS11;
CISZT = ( CHNEUTRE * 0.) + CIS22;
CISRT = ( CHNEUTRE * 0.) + CIS33;
ALPH12 = ( CHNEUTRE * 0.) + ALPH11;
ALPH22 = ( CHNEUTRE * 0.) + ALPH21;
ALPH32 = ( CHNEUTRE * 0.) + ALPH31;
RHO1 = ( CHNEUTRE * 0.) + RHO;

YOUNG1 = CHAN CHAM (NOMC YG1 YOUNGR) MODL1 RIGIDITE;
YOUNG2 = CHAN CHAM (NOMC YG2 YOUNGZ) MODL1 RIGIDITE;
YOUNG3 = CHAN CHAM (NOMC YG3 YOUNGT) MODL1 RIGIDITE;
NU1 = CHAN CHAM (NOMC NU12 NURZ) MODL1 RIGIDITE;
NU2 = CHAN CHAM (NOMC NU23 NUZT) MODL1 RIGIDITE;
NU3 = CHAN CHAM (NOMC NU13 NURT) MODL1 RIGIDITE;
CIS1 = CHAN CHAM (NOMC G12 CISRZ) MODL1 RIGIDITE;
CIS2 = CHAN CHAM (NOMC G23 CISZT) MODL1 RIGIDITE;
CIS3 = CHAN CHAM (NOMC G13 CISRT) MODL1 RIGIDITE;
ALPH1 = CHAN CHAM (NOMC ALP1 ALPH12) MODL1 RIGIDITE;
ALPH2 = CHAN CHAM (NOMC ALP2 ALPH22) MODL1 RIGIDITE;
ALPH3 = CHAN CHAM (NOMC ALP3 ALPH32) MODL1 RIGIDITE;
RHO = CHAN CHAM (NOMC 'RHO' RHO1) MODL1 RIGIDITE;

SI ((EGA TYPEMAT COMI) OU ( EGA TYPEMAT MABIPLAN));
 MAT11 = YOUNG1 ET YOUNG2 ET NU1;
 MAT22 = CIS1;
 MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
 MAT44 = ALPH1 ET ALPH2 ET RHO;
FINSI;
SI ( EGA TYPEMAT COEP);
 MAT11 = YOUNG1 ET YOUNG2 ET NU1;
 MAT22 = CIS1 ET CIS2 ET CIS3;
 MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
 MAT44 = ALPH1 ET ALPH2 ET RHO;
FINSI;
SI ( EGA TYPEMAT MABIAXI);
 MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
 MAT22 = CIS1;
 MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
 MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
FINSI ;
SI ( EGA TYPEMAT MABIFOU) ;
 MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
 MAT22 = CIS1 ET CIS2 ET CIS3;
 MAT33 = VRX1 et VRY1 et VZX1 et VZY1;
 MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
FINSI;
SI  ( EGA TYPEMAT MAS3D);
 MAT11 = YOUNG1 ET YOUNG2 ET YOUNG3 ET NU1 ET NU2 ET NU3;
 MAT22 = CIS1 ET CIS2 ET CIS3;
 MAT33 = VRX1 et VRY1 et VRZ1 et VZX1 et VZY1 et VZZ1;
 MAT44 = ALPH1 ET ALPH2 ET ALPH3 ET RHO;
FINSI;

MAT1 = MAT11 ET MAT22 ET MAT33 ET MAT44;
MATGEO = CHAN TYPE MAT1 CARACTERISTIQUES;

FINPROC MATGEO MODL1 ;


**** @PDROP
DEBPROC  @PDROP TAB1*TABLE  ;
*************************************************************************
*                    CALCUL CHUTE DE PRESSION                           *
*************************************************************************
*123456789012345678901234567890123456789012345678901234567890123456789012
*         1         2         3         4         5         6         7*
 MESS ' ';
NIVEAU   =  TAB1 . 'NIVEAU';
*
SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> calling @PDROP';
FINSI ;
*
* entrees
*
DIAM     =  TAB1 . 'D_MAQUETTE'                  ;
VIT      =  TAB1 . 'V_IN'                   ;
TEAU     =  TAB1 . 'T_IN'                   ;
LMAQ     =  TAB1 . 'L_MAQUETTE'                   ;
LH       =  TAB1 . 'L_HEATED'                    ;
PIN      =  TAB1 . 'P_IN'                  ;
TAPE     =  TAB1 . 'T_TAPE'                ;
YTW      =  TAB1 . 'TWIST_RATIO'               ;
*
SI ( NON ( EXISTE TAB1 ORIGIN_LH))          ;
 TAB1 . ORIGIN_LH   = 0.                   ;
 SI (NIVEAU >EG 2) ;
  MESS '>@PDROP> ORIGIN_LH set to default value : 0';
 FINSI                                       ;
FINSI                                       ;
ZLH      =  TAB1 . 'ORIGIN_LH'                  ;

PI       =   3.14159                        ;
*
*****************TABLE DE L EAU***************************************
*---  RHO de l eau en fonction de la temperature
PTRHO = PROG   0.     20.   40.   60.   80.  100.  120.  140.  160.
             180.    200.  220.  240.  260.  280.6 300.             ;
PRHOF = PROG 1022.3 1000.5 994.6 985.5 974.1 960.6 945.3 928.3 909.7
              889.0  866.8 842.4 815.7 785.9 752.6 714.3             ;
*---  VISCO   de l eau en fonction de la temperature
PTNNU = PROG   0.     20.    40.   60.    80.    100.  120.    140.
  160.   180.     200.    220.   240.    260.    280.6    300. ;
PNNU  = PROG 1.8E-3 1.E-3 .65E-3 .47E-3 .35E-3 .28E-3 .23E-3 .20E-3
.172E-3 .154E-3 .138E-3 .126E-3 .117E-3 .108E-3 .102E-3 .96E-4 ;
**********************************************************************
 RHO_N   = IPOL TEAU PTRHO PRHOF                                    ;
 N_NU    = IPOL TEAU  PTNNU PNNU                                    ;
*
SI (YTW EGA 0.)                            ;
*
*---CANAL SANS SWIRL
  DH = DIAM        ;
  VIT1 = VIT       ;
   SI ( EXISTE  TAB1  RIP_FLOWS  )                         ;
    S1  =  ( TAB1 . RIP_FLOWS )                           ;
   FINSI                                                   ;
   SI ( EXISTE  TAB1  RIP_WETP  )                          ;
*    PERI =  ( TAB1 . RIP_WETP )                           ;
*    DH   =  4. * S1 / PERI                              ;
    DH = DIAM        ;
   FINSI                                                   ;
   SI ( EXISTE  TAB1  RIP_TWIST  )                         ;
    PIS2Y = PI / ( 2. *( TAB1 . RIP_TWIST ) )          ;
    FACV2 = ( 1. + ( PIS2Y ** 2 )  )  ** 0.5     ;
    VIT1 = VIT * FACV2                            ;
*    FACV  = MAXI ( PROG FACV FACV2 )             ;
   FINSI                                          ;
  RE = VIT1 * DH / ( N_NU / RHO_N )    ;
  MESS '>@PDROP> HYD. DIAM.         :' DH        ;
  MESS '>@PDROP> VITESSE            :' VIT1        ;
  MESS '>@PDROP> REYNOLDS           :' RE           ;
*  F_FRICT = TAB1.'LAMBDA'              ;
*  SI ( RE < 2.E4 )                   ;
*   MESS '>@PDROP> F_FRICT = 0.316 * ( RE ** -0.25 )' ;
*   F_FRICT = 0.316 * ( RE ** -0.25 ) ;
*  SINON                               ;
*   MESS '>@PDROP> F_FRICT = 0.184 * ( RE ** -0.20 )' ;
*   F_FRICT = 0.184 * ( RE ** -0.20 ) ;
*  FINSI                              ;
*  COEF = F_FRICT * LMAQ / DH        ;
*  PERT = RHO_N * (VIT ** 2.) /2.        ;
  SI ( EXISTE TAB1  'LAMBDA')            ;
   F_FRICT = TAB1.'LAMBDA'              ;
   MESS '>@PDROP> frict. fact. given:' F_FRICT ;
  SINON                                ;
   F_FRICT = (1.82*(LOG RE)/(LOG 10.) - 1.64) ** -2.             ;
   MESS '>@PDROP> F_FRICT=((1.82*(log10 RE)) - 1.64) ** -2.:' F_FRICT;
  FINSI                                                          ;
  DPRES = F_FRICT * LMAQ / DH * RHO_N * (VIT ** 2.) /2. ;

SINON                                      ;
*
*--- CANAL AVEC SWIRL
  QUASI =  ((PI * DIAM * DIAM / 4.) - (TAPE * DIAM))  ;
  PERII = ((PI * DIAM)+(2.*(DIAM - TAPE)))            ;
  DHI =  4. * QUASI / PERII                           ;
*
  PYI  =      PI / (2. * YTW )                        ;
  F1 = (1.+( PYI ** 2. ))**(0.5)                      ;
  RE = F1 * VIT * DHI / ( N_NU / RHO_N )              ;
  MESS '>@PDROP> HYD. DIAM.         :' DHI             ;
  MESS '>@PDROP> VITESSE LONG.      :' VIT             ;
  MESS '>@PDROP> VITESSE UTILE      :' (VIT * F1)      ;
  MESS '>@PDROP> REYNOLDS           :' RE              ;
  KFRIC =  0.3  * ( RE ** -0.25 )                     ;
*
* DPRI = 0.15 * ( DHI ** -1.25 ) * ((N_NU / RHO_N)**0.25)
*    * ( F1 ** 2.75 )  ;
* DPRE =  RHO_N  * ( VIT ** 1.75 )              ;
* DPRES = DPRI * DPRE * LMAQ                        ;
*---facteur correctif
* AF = 1.46   ;
* BF = 10100    ;
* DPRES = (DPRES * AF) + BF               ;
  DPRES = 0.158 * ((N_NU / RHO_N)**0.25) * ( DHI ** -1.25 )
     * ( F1 ** 2.84 ) * LMAQ  *  RHO_N * ( VIT ** 1.84 )   ;
*

FINSI                                     ;
*
*---DIFFERENTES PRESSIONS DANS LA MAQUETTE
*
TAB1 . V_RHO_N = RHO_N                ;
POUT = PIN - DPRES                    ;
PIN_LC = PIN - (DPRES * ZLH / LMAQ )   ;
POUT_LC =  PIN - (DPRES * (ZLH + LH) / LMAQ )   ;
PRESMOY  =    (PIN_LC + POUT_LC) / 2.             ;
*
MESS '>@PDROP> PIN                :' PIN                ;
MESS '>@PDROP> PIN  HEATED LENGHT :' PIN_LC             ;
MESS '>@PDROP> POUT HEATED LENGHT :' POUT_LC            ;
MESS '>@PDROP> POUT               :' POUT               ;
MESS '>@PDROP> MEAN PRESS.        :' PRESMOY            ;
MESS '>@PDROP> DP                 :' DPRES              ;
SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> exiting @PDROP';
FINSI ;
FINPROC  DPRES  PIN_LC  POUT_LC POUT         ;
**** @PPERM
DEBPROC @PPERM TAB1*'TABLE' ITE1/'ENTIER';
SI (NON (EXISTE TAB1 NISOV))  ;
 TAB1.NISOV = 7  ;
FINSI  ;
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
*
NIVEAU = TAB1.'NIVEAU' ;
SI (NIVEAU >EG 4) ;
 MESS ' -------------------> calling @PPERM';
FINSI ;
 MESS '  ';
 MESS '  ';
 MESS ' #########################################################  ';
 MESS '    POST TRAITEMENT DES CALCULS THERMIQUES STATIONAIRES ';
 MESS ' #########################################################  ';
 MESS '  ';
 MESS '  ';

* RM 07/03/97
* pb dans les legendes des traces : il faudrait faire le menage
*
*
*
*
*
*
*JS 11/1/95 TAB1.V_FACFM1 est utilise pour le calcul de la puissance
*           donnee en commentaire sur les courbes
*le probleme est que dans le cas d un lambdaq TAB1.LIS_FLUX contient
* la liste des PHI0 a traiter et non le flux moyen commme dans le
* cas canon le plus simple serait peut etre d exiger LIS_PHI0
* et de CREER LIS_FLUMOYEN dans ce cas....
*
*
si (existe tab1 points) ;
 ind1 = inde (tab1.points) ;
finsi ;
*
* INITIALISATION DES PROG
*
SI ((NON (EXISTE TAB1 GRAPH1)) OU (NON (EXISTE  ITE1 )));
   TAB1.GRAPH1 = TABLE;
   TAB1.GRAPH1.LITICZ = PROG;
   TAB1.GRAPH1.LITMCZ = PROG;
   TAB1.GRAPH1.LITMP = PROG;
   TAB1.GRAPH1.LIFLU = PROG;
   TAB1.GRAPH1.LIFL = PROG;
   TAB1.GRAPH1.LIFLUM = PROG;
   TAB1.GRAPH1.FLUCRIT = PROG;
   TAB1.GRAPH1.FLUCRITJB = PROG;
   TAB1.GRAPH1.LIFLUEV = PROG;
   TAB1.GRAPH1.LIFLUP = PROG;
   TAB1.GRAPH1.LIFLUC = PROG;
   TAB1.GRAPH1.LIFLUR = PROG;
   TAB1.GRAPH1.L90PF = PROG;
   TAB1.GRAPH1.L80PF = PROG;
   TAB1.GRAPH1.L70PF = PROG;
   TAB1.GRAPH1.POFLUC = PROG;
   TAB1.GRAPH1.POFLUR = PROG;
   IPP1 = 0 ;

si (existe tab1 li_point) ;
   TAB1.LIS_TEMP = TABLE    ;
   REPETER BOUPO6 (DIME TAB1.LI_POINT);
    IPP1 = IPP1 + 1 ;
    TAB1.LIS_TEMP . IPP1 = PROG;
   FIN BOUPO6;
finsi ;
si (existe tab1 points) ;
 TAB1.LIS_TEMP = TABLE             ;
 TAB1.LIS_TEMP . 0 = PROG;
 REPETER BOUPO6 ;
  si (exis ind1 &BOUPO6) ;
   TAB1.LIS_TEMP . &BOUPO6 = PROG;
  sinon ;
   quitter BOUPO6 ;
  finsi ;
 FIN BOUPO6;
finsi ;

   SI ( EXISTE TAB1 EVEXP)                     ;
    TAB2 = INDEX (TAB1.EVEXP)                    ;
    IPP1 = 0 ;
    TAB1.LIS_FPAROI = TABLE ;
    TAB1.LIS_DTPAROI = TABLE ;
    TAB1.LIS_DTEXP = TABLE ;
    REPETER BOUPO7   (DIME TAB2)                 ;
     IPP1 = IPP1 + 1;
     TAB1.LIS_FPAROI . IPP1 = PROG                       ;
     TAB1.LIS_DTPAROI . IPP1 = PROG                       ;
     TAB1.LIS_DTEXP . IPP1 = PROG                       ;
    FIN BOUPO7;
   FINSI      ;

FINSI;
SI (NON (EXISTE  ITE1 ));
 NN1 = DIME  TAB1.LIS_FLUX ;
 ITER = 0 ;
SINON ;
 NN1 = 1  ;
 ITER  = ITE1 ;
FINSI;
SI (NON (EXISTE  TAB1 LFLUX_CONV_DESS ));
 TAB1.LFLUX_CONV_DESS = TAB1.LFLUX_CONV ;
FINSI;
*
* DEBUT DU POST TRAITEMENT : EXTRACTION DES 'T' ET 'H' -> TRACE ISOV.
*
*
COTETF1 = TAB1.C_COTETF1;
SITETF1 = TAB1.C_SITETF1;

COTETR1 = TAB1.C_COTETR1;
SITETR1 = TAB1.C_SITETR1;

COTETC1 = TAB1.C_COTETC1;
SITETC1 = TAB1.C_SITETC1;


S_TOT1 = TAB1.'M_ILLAGE_TOT';
C_ONT1 = TAB1.'M_IL_CONTOUR';

SI  (EXISTE  TAB1 'MAIL_TOT_DESS' );
 S_TOT2 = TAB1.'MAIL_TOT_DESS';
 C_ONT2 = TAB1.'MAIL_CONTOUR_DESS';
SINON                              ;
 S_TOT2 = TAB1.'M_ILLAGE_TOT';
 C_ONT2 = TAB1.'M_IL_CONTOUR';
FINSI                        ;

REPETER BOO1 NN1 ;

SI  (NON (EXISTE  ITE1 ));
 ITER = ITER + 1 ;
FINSI     ;
MESS ' ';
MESS '---------------------------------------';
MESS ' Exploitation of Step number ' ITER  ;
MESS ' Heat flux [MW/m2] ' ((EXTR TAB1.LIS_FLUX ITER)/1.E6);
MESS ' ';

VFPAT1 = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ITER);
* FLU1 est le flux moyen
SI ( EXISTE TAB1 'LAMDAQ'  );
   SI (  EXISTE TAB1 'V_FACFM1');
    FLU1  = (EXTR TAB1.LIS_FLUX ITER)  * TAB1.V_FACFM1   ;
   SINON                                                 ;
    FLU1  = (EXTR TAB1.LIS_FLUX ITER)  *  TAB1.'V_FACFM2';
   FINSI                                                 ;
*   FLU1  = (EXTR TAB1.LIS_FLUX ITER)   *  TAB1.V_FACFM1;
*js15.5.97*   SI ( EXISTE TAB1 'CENTRE_PLASMA'  );
*js15.5.97*     PUI1  = FLU1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED );
*js15.5.97*   SINON;
*js15.5.97*     PUI1  = FLU1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED );
*js15.5.97*   FINSI;
SINON;
   FLU1  = (EXTR TAB1.LIS_FLUX ITER);
*js15.5.97*   PUI1  = FLU1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED );
   TAB1 . WE_HEATED = TAB1 . W_HEATED;
FINSI;
PUI1  = RESU TAB1.I_FPAT1.ITER  ;
*
MOTITR = TAB1.TITR_MAQ ;
TITRE MOTITR '- ISOV. T. VAL FLUX: ' FLU1 'VAL PUIW LIN MAIL :' PUI1;
*123456789012345678901234567890123456789012345678901234567890123456789012
TE1 = TAB1.ITER;
SI ( EXISTE TAB1 LIS_TPER );
 III1 = EXTR TAB1.LIS_TPER ITER;
SINON;
 III1 = FLOT ITER;
FINSI;
CHT1    = EXCO 'T' TE1;
*<JS deb
SI ( EGA ( TYPE ( TAB1.RESUTHER.'VALEUR_TETA'.ITER)) 'CHPOINT ');
 V_TETA  = EXCO 'T' ( TAB1.RESUTHER.'VALEUR_TETA'.ITER)  ;
SINON                                       ;
 V_TETA  = TAB1.RESUTHER.'VALEUR_TETA'.ITER;
FINSI                                      ;
HCONVT1 = EXCO 'H' ( TAB1.RESUTHER.COEFECHANGE.ITER )  ;
HCONRT1 = EXCO 'H' ( TAB1.RESUTHER.COEFRAYONNE.ITER )  ;
*<JS fin
*
MESS ' MAXI MINI TEMPERATURES ' ( MAXI CHT1) ( MINI CHT1 ) ;
CHTI0 = ( REDU CHT1 TAB1.LFLUX_CONV  )            ;
MACHTI0 = MAXI CHTI0                      ;
MICHTI0 = MINI CHTI0                      ;
CHTI2 = CHTI0 * 1.E5                    ;
*<JS deb
CHTI1 = CHTI0  - V_TETA                   ;
FLH1  = FLUX (TAB1.'MODELV') (  HCONVT1 * -1. );
FLI1  = FLH1 * CHTI1                    ;
FLI2  = HCONVT1 * CHTI1                     ;
*<JS fin
*<JS>FLI2  =  @IPOE CHTI0 TAB1.'EV_FLUX_CONV'.ITER               ;
*<JS>FLI1  = FLUX (TAB1.'MODELV') (FLI2 * -1.);
MESS ' MAXI MINI TEMP. CONV ' ( MAXI CHTI0) ( MINI CHTI0) ;
*
CHTIR0 = ( REDU CHT1 (TAB1.LFLUX_RAYO)  )      ;
CHTIR2 = CHTIR0 * 1.E5                    ;
*<JS deb
CHTIR1 = CHTIR0 - TAB1.TEMP_RAYO;
FLHR1  = FLUX (TAB1.'MODELR') (  HCONRT1 * -1. );
FLIR1  = FLHR1 * CHTIR1;
FLIR2  = HCONRT1 * CHTIR1;
*<JS fin
*<JS>FLIR2  = @IPOE CHTIR0 TAB1.'EV_FLUX_RAYO'.ITER ;
*<JS>FLIR1  = FLUX (TAB1.'MODELR') (  FLIR2 * -1. );
SI ( EGA TAB1.HYPERVAP VRAI ) ;
 AMPLV1 = ( TAB1 . DH ) / (2. * TAB1.MAX_SOFL )  ;
SINON ;
 AMPLV1 = ( TAB1 . D_MAQUETTE ) / (2. * TAB1.MAX_SOFL);
FINSI ;
CHPX = EXCO SCAL ( FLIR2 * ( COTETR1 ) ) UX;
CHPY = EXCO SCAL ( FLIR2 * ( SITETR1 ) ) UY;
CHPT = @ET CHPX CHPY;
SI( EGA 3 (VALE DIME));
 C3TETR1 = TAB1.C_C3TETR1;
 CHPZ = EXCO SCAL ( FLIR2 * ( C3TETR1 ) ) UZ;
 CHPT = @ET CHPT CHPZ;
FINSI  ;
CHPT = REDU CHPT S_TOT2                            ;
TAB1. V_VEC33 = @VECADA CHPT  AMPLV1 'ROUGE' ;
MESS ' MAXI MINI TEMP. RAYO ' ( MAXI CHTIR0) ( MINI CHTIR0) ;
*>MESS ' MAXI MINI DT    RAYO ' ( MAXI CHTIR1) ( MINI CHTIR1) ;
*>MESS ' MAXI MINI H     RAYO ' ( MAXI HCONRT1) ( MINI HCONRT1);
MESS ' MAXI MINI FLUX  RAYO ' ( MAXI FLIR2) ( MINI FLIR2);
MESS ' MAXI MINI FLUX  CONV ' ( MAXI FLI2 ) ( MINI FLI2 )  ;
*
*--- CREATION DES FLECHES (FLUX)            :
*
CHPX = EXCO SCAL ( FLI2 * ( COTETC1 ) ) UX;
CHPY = EXCO SCAL ( FLI2 * ( SITETC1 ) ) UY;
CHPT = @ET CHPX CHPY;
SI( EGA 3 (VALE DIME));
 C3TETC1 = TAB1.C_C3TETC1;
 CHPZ = EXCO SCAL ( FLI2 * ( C3TETC1 ) ) UZ;
 CHPT = @ET CHPT CHPZ;
FINSI  ;
CHPT = REDU CHPT S_TOT2                            ;
TAB1. V_VEC1 = @VECADA CHPT ( 1. * AMPLV1) 'ROUGE'  ;

   CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX      ;
   CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY      ;
   CHPT = (@ET CHPX CHPY  );
   SI( EGA 3 (VALE DIME));
    C3TETF1 = TAB1.C_C3TETF1;
    CHPZ = EXCO SCAL ( VFPAT1 * ( C3TETF1 ) ) UZ;
    CHPT = @ET CHPT CHPZ;
   FINSI  ;
 CHPT = REDU CHPT S_TOT2                            ;
TAB1. V_VEC22 = @VECADA (-1. * CHPT) ( -1. *  AMPLV1 )  'VERT' ;

*
* --- TRACE DES ISOVALEURS ET DES FLUX
*
VEC_00 = TAB1.V_VEC22 ET TAB1.V_VEC1 ET TAB1.V_VEC33   ;
TE2 = REDU TAB1.ITER  S_TOT2                            ;
TRAC 'CACH' TAB1.VIEW_P TAB1.NISOV TE2 S_TOT2 VEC_00 C_ONT2;

SI ( EXISTE TAB1 VIEW_P2 );
  TRAC CACH TAB1.VIEW_P2 TAB1.NISOV TE2 S_TOT2 C_ONT2
       (VEC1 VEC22 VEC_33);
FINSI;

SI ( NON( EXISTE TAB1 TRAC_GRAD ) );
   TAB1.TRAC_GRAD = FAUX;
FINSI;

SI TAB1.TRAC_GRAD;
  MO_TOT = MODL S_TOT1 'THERMIQUE' 'ISOTROPE';
  VEGRA1 = @VECGRAD
        MO_TOT TAB1.RESUTHER.CONDUCMAT.ITER TE1 AMPLV1 'ROUGE';
  TRACER  TAB1.VIEW_P CACH TE1 S_TOT1 C_ONT1 VEGRA1   ;
FINSI                                                      ;
*
*--- TRACE DES COURBES: 'H'  'TEMP. ET FLUX SUR PAROI'
*
*>MESS ' COEF ECH SUR LA PAROI '    ;
*>MESS ' MAXI MINI  ' ( MAXI HCONVT1 ) ( MINI HCONVT1 )  ;
TAB1.'FLUPAROI'       =   FLI2              ;
MESS ' ';

SI ( NON ( EXISTE TAB1 COEF_ECH_V_ABS ) ) ;
 TAB1.COEF_ECH_V_ABS = FAUX           ;
FINSI                                 ;

SI (  TAB1.COEF_ECH_V_ABS )           ;
*> TITRE ' WALL HEAT TRANSFER COEF. (MAXI : ' ( MAXI HCONVT1 )       ;
*> TAB1.EVHS = EVOL VERT 'CHPO' ( HCONVT1 ) SCAL TAB1.LFLUX_CONV_DESS ;
*> TAB1.CH_H =  REDU HCONVT1 TAB1.LFLUX_CONV ;
*> DESSIN  TAB1.EVHS YBOR 0. 3.e5 'MARQ CROI REGU'    ;
FINSI                                 ;
* fin jb
SI( EGA 3 (VALE DIME));
 MESS '>>>> @PPERM>>>> ATTENTION EN 3D TAB1.LFLUX_CONV_DESS';
 MESS '>>>> @PPERM>>>> doit etre une ligne de TAB1.LFLUX_CONV';
FINSI  ;
* --- courbe 1 -> de temperature de la paroi fonction de l'abscisse
*TITRE ' TEMP. PAROI ' ;
FLI0     = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
*js EVCHTI21 = EVOL 'CHPO' CHTI2 SCAL TAB1.LFLUX_CONV_DESS  ;
EVCHTI21 = EVOL ROUG 'CHPO' (@ET CHTI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
EVTPAROI = EVOL ROUG 'CHPO' (@ET CHTI0 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;

* --- courbe 2 -> de l'evolution totale  tonb
*TITRE MOTITR 'WALL FLUX AND TEMP.  FLUX:  ' FLU1;
PLINT11 = EXTR EVCHTI21 ABSC;
EVTONB1 = EVOL ROUG MANU PLINT11
                 (PROG (DIME PLINT11)*(TAB1.V_TONB * 1.E5));

* --- courbe 3 -> flux a la paroi fonction de l'abscisse
*TITRE ' FLUX PAROI ' ;
*js EVFLI11  = EVOL 'CHPO' FLI2  SCAL TAB1.LFLUX_CONV_DESS ;
FLI0     = MANU CHPO TAB1.LFLUX_CONV_DESS 1 'SCAL' 0. ;
EVFLI11  = EVOL VERT 'CHPO' (@ET FLI2 FLI0) SCAL TAB1.LFLUX_CONV_DESS ;
EVFPAROI  = EVFLI11    ;

* --- courbe 4 -> Valeur demi du flux a la paroi
*TITRE ' DEMI FLUX PAROI ' ;
EVFL1S2 = EVOL VERT MANU PLINT11
         (PROG (DIME PLINT11)*((MAXI FLI2) / 2.));


EVE_PREP = EVCHTI21 ET EVTONB1 ET EVFLI11 ET EVFL1S2 ;
EVE_PRJB = EVE_PREP                       ;
*
* --- préparation des légendes
*
* les temperatures ont des symboles ouverts
* les flux des symboles fermes
TAC2 = TABLE;
TAC2.TITRE = TABLE ;
TAC2.1 = 'MARQ CROI REGU' ;  TAC2.TITRE.1 = 'WALL_TEMP' ;
TAC2.2 = 'MARQ ETOI REGU' ; TAC2.TITRE.2 = 'TONB'      ;
TAC2.3 = 'MARQ LOSA REGU' ; TAC2.TITRE.3 = 'WALL_FLUX' ;
TAC2.4 = 'MARQ TRIB REGU' ; TAC2.TITRE.4 = 'HALF_FLUX' ;
TAC2.5 = 'MARQ CARR REGU' ; TAC2.TITRE.5 = 'TONG75' ;
* a ce niveau, t,tonb, Wallflux sont pret a etre traces
* traces des différents flux critiques demandés

LLL1 = MOTS 'CARR' 'TRIA' 'TRIB' 'CARR' 'TRIA' 'TRIB';
TITR 'FLUX AND TEMPERATURE WALL EVOLUTION';

I1 = 1 ;
REPETER BOUC6 (DIME TAB1.FLUX_CRITIQUE.ITER) ;
 EVE_PREP = EVE_PREP ET
 (EVOL VERT MANU PLINT11 (PROG (DIME PLINT11)*
                   (EXTR TAB1.FLUX_CRITIQUE.ITER I1 )));

 SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG 75')                 ;
  VALTI1 = TAB1.M_TONG                                           ;
 FINSI                                                           ;
 SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR')                 ;
  VALTI1 = 'BOWRING72'                                           ;
 FINSI                                                           ;
 SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA')                 ;
  VALTI1 = 'CELATA94'                                           ;
 FINSI                                                           ;

 TAC2.(4 + I1) = CHAI 'MARQ ' (EXTR LLL1 I1) ' REGU TITRE ' VALTI1 ;
 I1 = I1 + 1                                                     ;
FIN BOUC6                                                        ;
SI ( NON ( EXISTE TAB1 M_TONGJB ) )                              ;
 TAB1.M_TONGJB = FAUX                                            ;
FINSI                                                            ;

SI TAB1.M_TONGJB                                                 ;
 SI ((DIME TAB1.CHFCORRELATION) > 1) ;
  ERRE 'trop de correlations : incompatible avec TAB1.M_TONGJB';
 FINSI                                                           ;
 EVCHF2  =  EVOL JAUN MANU PLINT11  (PROG (DIME PLINT11)
                 *(EXTR TAB1.FLUX_CRITIQUE.ITER 1))  ;
 EVCHFJB = EVOL JAUN MANU PLINT11
                (PROG (DIME PLINT11)*(TAB1.FLJB_CRI_TONG.ITER))  ;
 TAC2.6 = 'MARQ CARR REGU TITRE 1.67*TONG75'                     ;
 TAC2.7 = 'MARQ TRIB REGU TITRE TONG75 CHF'                      ;
 DESSIN (EVE_PRJB ET EVCHF2 ET EVCHFJB) LEGE MIMA TAC2           ;
SINON                                                            ;
 DESSIN EVE_PREP LEGE MIMA TAC2                                  ;
 TAB1.EVE_PREP1 = EVE_PREP ;
FINSI                                                            ;
MESS ' TEMP MAXI SUR PAROI             : ' MACHTI0      ;
MESS ' TEMP MINI SUR PAROI             : ' MICHTI0      ;
SI (EXISTE TAB1 LO_FLUI) ;
  SI TAB1.LO_FLUI;
    TEX_1 = (REDU CHT1 (TAB1.LFLUX_EXTE_DESS ));
    EVTEX1 = EVOL 'CHPO' (TEX_1 * 1.E4) 'SCAL' (TAB1.LFLUX_EXTE_DESS);
    EVFLEX1 = EVOL 'CHPO' VFPAT1 'SCAL' (TAB1.LFLUX_EXTE_DESS);
    TITRE 'INCIDENT FLUX AND TEMPERATURE '  FLU1;
    TAC2.1 = 'MARQ CROI REGU TITRE INCIDENT_FLUX'          ;
    TAC2.3 = 'MARQ CARR REGU TITRE L_EXT_TEMP'          ;
    DESSIN (EVFLEX1 ET EVTEX1) LEGE MIMA  TAC2 ;
  FINSI                                               ;
FINSI                                               ;
*
* --- EXTRACTION DES TEMP. AUX PTS DESIRES
 SI ( EXISTE TAB1 LI_POINT )                         ;
*
* les 10 lignes suivantes sont assez délicates
* svp ne pas modifier sans l'avis de RM ou JS
*
IPP1 = 0;
REPETER BOUPO1   (DIME TAB1.LI_POINT)                 ;
     IPP1 = IPP1 + 1;
     T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_POINT);
*js cast95 n'accepte plus un text ds EXTR
*js donc on lui recree le point
     T_P3 = S_TOT1 'POIN' 'PROC' (T_P1)         ;
     T_P2 =  EXTR IPP1 TAB1.LI_POINT ;
*     list (T_P1) ;
     TMIP1  = EXTR TE1 'T' T_P3;
     MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' T_P2;
     TAB1.LIS_TEMP . IPP1 =
                 ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 )    ;
FIN BOUPO1;
  FINSI                                                      ;

* autre syntaxe pour le meme resultat, RM101098
 si (existe tab1 points) ;
  repe boupo7 ;
   si (existe ind1 &boupo7) ;
    nom1 = ind1.&boupo7 ;
    poa1 = tab1.points.nom1 ;
    IPP1 = &boupo7 ;
     TMIP1  = EXTR TE1 'T' poa1;
     MESS ' TEMPERATURE ................... : ' TMIP1 'EN ' nom1;
     TAB1.LIS_TEMP . IPP1 =
                 ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 )    ;
   sinon ;
    quitter boupo7 ;
   finsi ;
  fin boupo7;
 finsi ;

MESS ' ';
IPP1 = 0;
REPETER BOUMA1;
    IPP1 = IPP1 + 1;
    SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                             ;
       TMMA1 = MAXI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
       TIMA1 = MINI ( REDU CHT1 (TAB1.ZONE_MAT.IPP1 ) );
*****MESS ' SWIRL TAPE THICKNESS    (M)     : ' TTAPE;
       MESS ' TEMPERATURE MAXI............... : ' TMMA1
                           'MAT. '        (TAB1.NOM_MAT.IPP1 );
       MESS ' TEMPERATURE MINI............... : ' TIMA1
                           'MAT. '        (TAB1.NOM_MAT.IPP1 );
    SINON   ;
       QUITTER BOUMA1  ;
    FINSI     ;
FIN BOUMA1;

MESS ' ' ;
MESS 'densite de flux de chaleur (W/m²)' ;
MESS ' ' ;
MESS ' FLUX MOYEN .....................: ' FLU1;
FLUMAE = ( MAXI VFPAT1);
MESS ' FLUX MAXI ENTRANT...............: ' FLUMAE;
FLUMIE = ( MINI VFPAT1);
MESS ' FLUX MINI ENTRANT...............: ' FLUMIE;
FLUMAS = ( MAXI FLI2 );
MESS ' FLUX MAXI SORTIE ...............: ' FLUMAS;
FLUMIS = ( MINI FLI2 );
MESS ' FLUX MINI SORTIE ...............: ' FLUMIS;
RPAT1 = MAXI (RESU TAB1.I_FPAT1.ITER);
*js15.5.97*PRPAT1 = ((RPAT1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
PRPAT1 = RPAT1 ;
RLI1 = MAXI ( RESU  FLI1);
*js15.5.97*PRLI1 = ((RLI1 * (TAB1.FSYM_X)) * TAB1.L_HEATED);
PRLI1 = RLI1  ;
ARLI1 = ABS PRLI1;
POULI1 = ( ARLI1 /PRPAT1 ) * 100.;
RLIR1 = MAXI (RESU FLIR1);
*js15.5.97*PRLIR1 = ((RLIR1 *(TAB1.FSYM_X)) * TAB1.L_HEATED);
PRLIR1 = RLIR1 ;
ARLIR1 = ABS PRLIR1;
POULIR1 = ( ARLIR1 /PRPAT1 ) * 100.;
***MESS ' SWIRL TAPE THICKNESS    (M)     : ' TTAPE;
SI ( EXISTE TAB1 'LAMDAQ' );
   MESS ' LONGUEUR DE DECROISSANCE        : ' TAB1.'LAMDAQ' ;
   MESS ' FLUX DEMANDE PHIO               :   '
                       (EXTR TAB1.LIS_FLUX ITER);
FINSI;
MESS ' ' ;
MESS 'en 2D puissance en Watts par metre de tube (W/m)' ;
MESS ' ' ;
MESS ' RESULTANTE FLUX INCIDENT        : '   RPAT1     ;
MESS ' RESULTANTE FLUX DE CONVECTION   : '   RLI1  ;
MESS ' RESULTANTE FLUX DE RAYONNEMENT  : '   RLIR1 ;

MESS ' ' ;
MESS 'en 2D puissance en Watts par metre sur la maquette maillee(W/m)' ;
MESS ' ' ;
MESS ' PUISSANCE INCIDENTE             : ' PRPAT1  ;
MESS ' PUISSANCE DANS L EAU            : ' PRLI1  '(' POULI1  '%)' ;
MESS ' PUISSANCE RAYONNEE              : ' PRLIR1 '(' POULIR1 '%)' ;
MESS ' BILAN THERMIQUE                 : ' (PRPAT1 + PRLI1 + PRLIR1 );
TICZ1 = MINI CHT1;
TAB1.GRAPH1.LITICZ = TAB1.GRAPH1.LITICZ ET (PROG TICZ1);
TAB1.GRAPH1.LITMP = TAB1.GRAPH1.LITMP ET (PROG MACHTI0);
*        attention RLIR1 est negatif
*js15.5.97*FLU11  = FLU1 + (RLIR1 / TAB1.W_HEATED * TAB1 . FSYM_X);
FLU11  = FLU1 + (RLIR1 / (MESU TAB1.LFLUX_RAYO) ) ;
MENAGE;

SI ( EXISTE TAB1 EVEXP)                     ;
* TAB2 = INDEX TAB1.EVEXP                    ;
 IPP1 = 0 ;
 REPETER BOUPO2   (DIME  TAB2)                 ;
     IPP1 = IPP1 + 1;
*     T_P1 = 'TEXT' ('EXTR' IPP1 TAB1.LI_THEB);
     T_P1 = 'TEXT' TAB2.IPP1                  ;
     T_P3 = S_TOT1 'POIN' 'PROC' (T_P1)         ;
*     T_P4 =  EXTR IPP1 TAB1.LI_THEB ;
     T_P4 =  TAB2.IPP1                  ;
     T_TH1  = EXTR TE1 'T' T_P3;
     TEXP_TH1 = @IPOE TAB1.EVEXP.T_P4  FLU11                 ;

  SI  (TEXP_TH1    < (TAB1.V_TONB + 1.) ) ;
   QUITTER BOUPO2;
  SINON;
   DTEXP_T1 = T_TH1 - TEXP_TH1                              ;
   MESS ' TEMPERATURE DE TH..calcule..... : ' T_TH1 'EN ' T_P4;
   MESS ' TEMPERATURE experimentale...... : ' TEXP_TH1;
   XPAROI = OPIE EVTPAROI T_TH1 'FIXE'  ;
   MESS ' ABSCISSE CURV ...........XPAROI : ' XPAROI;
   TPAROI = @IPOE EVTPAROI XPAROI 'FIXE' ;
   DTSATP = TPAROI - TAB1.T_SAT           ;
   DTSATEXP  = DTSATP - DTEXP_T1   ;
*   FPAROI = @IPOE EVFPAROI  XPAROI 'FIXE' ;
   FPAROI = @IPOE TAB1.EVOFE1  TPAROI 'FIXE' ;
   MESS ' TPAROI FPAROI ..................: ' TPAROI FPAROI;
  FINSI ;
  SI ( (DTSATP    <EG 0. ) OU
       (DTSATEXP  <EG 0. )  );
   QUITTER BOUPO2;
  SINON;

   TAB1.LIS_DTPAROI . IPP1 =
                 ( TAB1.LIS_DTPAROI . IPP1 ) ET ( PROG DTSATP);
   TAB1.LIS_DTEXP . IPP1 =
                 ( TAB1.LIS_DTEXP . IPP1 ) ET ( PROG DTSATEXP);
   TAB1.LIS_FPAROI . IPP1 =
                 ( TAB1.LIS_FPAROI . IPP1 ) ET ( PROG FPAROI ) ;
  FINSI ;
 FIN BOUPO2;
FINSI      ;
SI ( NON (EXISTE TAB1 LCAPKPC));  TAB1.LCAPKPC = VRAI; FINSI;
SI TAB1.LCAPKPC;
 SI ( EGA TAB1.HYPERVAP VRAI ) ;
  ALPF90 PF90  = @CAPKPC EVFLI11 .9 TAB1.DH  FLU11 NIVEAU;
  ALPF80 PF80  = @CAPKPC EVFLI11 .8 TAB1.DH  FLU11 NIVEAU;
  ALPF70 PF70  = @CAPKPC EVFLI11 .7 TAB1.DH  FLU11 NIVEAU;
 SINON ;
  ALPF90 PF90  = @CAPKPC EVFLI11 .9 TAB1.D_MAQUETTE  FLU11 NIVEAU;
  ALPF80 PF80  = @CAPKPC EVFLI11 .8 TAB1.D_MAQUETTE  FLU11 NIVEAU;
  ALPF70 PF70  = @CAPKPC EVFLI11 .7 TAB1.D_MAQUETTE  FLU11 NIVEAU;
 FINSI ;
 TAB1.GRAPH1.L90PF  = TAB1.GRAPH1.L90PF ET (PROG PF90);
 TAB1.GRAPH1.L80PF  = TAB1.GRAPH1.L80PF ET (PROG PF80);
 TAB1.GRAPH1.L70PF  = TAB1.GRAPH1.L70PF ET (PROG PF70);
FINSI ;

 TAB1.GRAPH1.LIFL   = TAB1.GRAPH1.LIFL ET (PROG FLU1);
 TAB1.GRAPH1.LIFLU  = TAB1.GRAPH1.LIFLU ET (PROG FLU11);
 TAB1.GRAPH1.LIFLUM = TAB1.GRAPH1.LIFLUM ET (PROG FLUMAS);

TAB1.GRAPH1.FLUCRIT = TAB1.GRAPH1.FLUCRIT
                      ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
*jb
SI TAB1.M_TONGJB  ;
 TAB1.GRAPH1.FLUCRITJB = TAB1.GRAPH1.FLUCRITJB
                      ET (PROG (EXTR TAB1.FLUX_CRITIQUE.ITER 1));
FINSI ;
*jb
SI ( EGA TAB1.HYPERVAP VRAI ) ;
 FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.DH ) ;
SINON ;
 FLUEVAL = (FLU11 * (TAB1.W_HEATED) / TAB1.D_MAQUETTE);
FINSI ;
TAB1.GRAPH1.LIFLUEV = TAB1.GRAPH1.LIFLUEV ET ( PROG FLUEVAL );
TAB1.GRAPH1.LIFLUP = TAB1.GRAPH1.LIFLUP ET ( PROG PRPAT1 );
TMCZ1  = MAXI  CHT1;
TAB1.GRAPH1.LITMCZ = TAB1.GRAPH1.LITMCZ ET ( PROG TMCZ1);
TAB1.GRAPH1.LIFLUC = TAB1.GRAPH1.LIFLUC ET ( PROG ARLI1);
TAB1.GRAPH1.LIFLUR = TAB1.GRAPH1.LIFLUR ET ( PROG ARLIR1);
TAB1.GRAPH1.POFLUC = TAB1.GRAPH1.POFLUC ET ( PROG POULI1);
TAB1.GRAPH1.POFLUR = TAB1.GRAPH1.POFLUR ET ( PROG POULIR1);
*

FIN BOO1 ;

* Traces pour la derniere iteration
*
SI (EGA (DIME TAB1.LIS_FLUX) ITER);
*--- TRACE DES  COURBES
*--- TEMP. DES PTS EN FCT DU FLUX INCIDENT CORRIGE ou reel
*
*  SI ( NON ( EXISTE  TAB1 PFLUXNCORR )) ;
   TAB1 .PFLUXNCORR = VRAI ;
*  FINSI         ;
 SI ( TAB1 .PFLUXNCORR )  ;
  MOTFLU = 'INCIDENT FLUX ' ;
  LLLFLU = TAB1.GRAPH1.LIFL ;
 SINON     ;
  MOTFLU = 'ENTERING FLUX ' ;
  LLLFLU = TAB1.GRAPH1.LIFLU ;
 FINSI     ;
   TITRE 'SECTION TMIN  CALCULATION';
   EVTIC  = EVOL MANU  MOTFLU LLLFLU
                       'TEMPERATURE'  TAB1.GRAPH1.LITICZ;
   TITRE ' WALL TMAX CALCULATION '       ;
   EVTIP  = EVOL MANU  MOTFLU LLLFLU
                       'TEMPERATURE' TAB1.GRAPH1.LITMP   ;

   L_SIGN1 = MOTS 'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB'
                  'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB'
                  'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB'
                  'PLUS' 'CROI' 'ETOI' 'LOSA' 'TRIA' 'CARR' 'TRIB';
*
* --- Tracés de T en fonction du flux
*

   EVTTTS1 =  EVOL MANU  ( PROG 0. ) ( PROG 0.) ;
   MESS ' >>>@PPERM>>>>  5.0 ' ;
*
* --- boucle sur les points
*
   TAC1 = TABLE ;
   TAC1.TITRE = TABLE ;
   IPP1 = 0  ;

si (existe TAB1 LI_POINT);
   REPETER BOUPO5 (DIME TAB1.LI_POINT);
    IPP1 = IPP1 + 1   ;
    T_P1 = TEXT (EXTR IPP1 TAB1.LI_POINT);
    T_P2 = EXTR IPP1 TAB1.LI_POINT;
*jb : 5 10 94 possibilite d'afficher la profondeur des TC
    SI ( NON ( EXISTE TAB1 DEEPCA )) ;
     TAB1.DEEPCA = FAUX   ;
    FINSI                   ;
    SI TAB1.DEEPCA  ;
     D_TC = EXTR IPP1 TAB1.DEEPCALC ;
     TITR 'C' T_P2 D_TC 'm' ;
    SINON ;
     TITR T_P2 'CALCULATION';
    FINSI ;
*
    SI ( IPP1 EGA 1 )  ;
     EVTTTS1 =
      ( EVOL MANU  MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
    SINON  ;
     EVTTTS1 = EVTTTS1 ET
      ( EVOL MANU  MOTFLU LLLFLU 'TEMPERATURE'  TAB1.LIS_TEMP.IPP1);
    FINSI;
*    TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)' REGU ';
    TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1);
   FIN BOUPO5  ;
finsi ;
si (existe TAB1 POINTS);
   REPETER BOUPO5 ;
    IPP1 = IPP1 + 1   ;
    si (existe ind1 &boupo5) ;
     nom1 = ind1.&boupo5 ;
     poa1 = tab1.points.nom1 ;
     IPP1 = &boupo5 ;
     SI ( NON ( EXISTE TAB1 DEEPCA )) ;
      TAB1.DEEPCA = FAUX   ;
     FINSI                   ;
     SI TAB1.DEEPCA  ;
      D_TC = EXTR IPP1 TAB1.DEEPCALC ;
      TITR 'C' nom1 D_TC 'm' ;
     SINON ;
      TITR nom1 'CALCULATION';
     FINSI ;
*
    SI ( IPP1 EGA 1 )  ;
     EVTTTS1 =
      ( EVOL MANU  MOTFLU LLLFLU 'TEMPERATURE' TAB1.LIS_TEMP.IPP1 );
    SINON  ;
     EVTTTS1 = EVTTTS1 ET
      ( EVOL MANU  MOTFLU LLLFLU 'TEMPERATURE'  TAB1.LIS_TEMP.IPP1);
    FINSI;
    TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;
    TAC1.TITRE.IPP1 =  nom1 ;
    sinon ;
     quitter  BOUPO5 ;
    finsi ;
   FIN BOUPO5  ;
finsi ;



   IPP1 = IPP1 + 1;



   TITR 'CALCUL SECTION TMAX' ;
   EVTMCZ  = EVOL MANU  MOTFLU LLLFLU
                        'TEMPERATURE' TAB1.GRAPH1.LITMCZ  ;
*   TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1)
*      ' REGU' ;
   TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ;

   MOTITR = TAB1.TITR_MAQ                     ;
   TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL')
                'V-LOCAL' (TAB1.'V_LOCAL')
                'P-LOCAL' (TAB1.'P_LOCAL');
   EVTTTS1 = EVTTTS1 ET EVTMCZ;
SI ((DIME TAB1.LIS_FLUX) >EG 2);

 SI ( EXISTE TAB1  EVOTEST) ;
  EVTTT = ( EVTTTS1 ET (TAB1 . EVOTEST) )       ;
  REPETER BOUTA1 (DIME (TAB1 . EVOTEST) )       ;
   IPP1 = IPP1 + 1;
   TAC1.IPP1 = CHAIN 'MARQ '(EXTR L_SIGN1 IPP1) ' NOLI' ;
  FIN BOUTA1;
 SINON  ;
  EVTTT =  EVTTTS1  ;
 FINSI  ;
   TAB1.EVORESU =  EVTTTS1  ;
   TAB1.EVTTT1   = EVTTT    ;
   DESSIN EVTTT LEGE MIMA  TAC1  ;
*
* --- autres tracés
*
   TAC1 = TABLE  ;
   TAC1.TITRE = TABLE  ;
   IPP1 = 0  ;
   SI ( EXISTE TAB1 EVEXP);
*   TAB2 = INDEX TAB1.EVEXP ;
   REPETER BOUPO8 (DIME TAB2);
     IPP1 = IPP1 + 1   ;
*     T_P2 = EXTR IPP1 TAB1.LI_THEB;
     T_P2 = TAB2.IPP1              ;
     TITRE TAB1.TITR_MAQ 'CORRELATION' TAB1.L_SUBNB ;
     SI ( (DIME  TAB1.LIS_FPAROI.IPP1) > 0);
       II1 = 2*IPP1 - 1;
       TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
       TAC1.TITRE.II1 =  T_P2 'CALCULATION'               ;
       II1 = 2*IPP1   ;
       TAC1.II1 = CHAIN 'MARQ ' (EXTR L_SIGN1 II1) ' NOLI';
       TAC1.TITRE.II1 =   T_P2 'EXP.'             ;
       SI ( IPP1 EGA 1 )  ;

          EVDTFPA1 = ( EVOL MANU  'DTSAT'  TAB1.LIS_DTPAROI.IPP1
                    'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 )   ;
          EVDTFPA1 = EVDTFPA1 ET
             ( EVOL MANU  'DTSAT'  TAB1.LIS_DTEXP.IPP1
                    'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 )   ;
       SINON  ;
          EVDTFPA1 = EVDTFPA1 ET
               ( EVOL MANU  'DTSAT'  TAB1.LIS_DTPAROI.IPP1
                    'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 )   ;
          EVDTFPA1 = EVDTFPA1 ET
               ( EVOL MANU  'DTSAT'  TAB1.LIS_DTEXP.IPP1
                    'WALL_FLUX' TAB1.LIS_FPAROI . IPP1 )   ;
       FINSI;
     FINSI;
   FIN BOUPO8  ;
    list EVDTFPA1 ;
    TITRE ' WALL_FLUX VERSUS DT_SAT'                   ;
    DESS EVDTFPA1  LOGX LOGY LEGE MIMA  TAC1          ;
   FINSI       ;
   TAC3 = TABLE;
   TAC3.1 = 'MARQ PLUS '   ;
   TAC3.2 = 'MARQ ETOI '   ;
   TAC3.3 = 'MARQ CROI '   ;
   TITRE 'INC. POWER ';
   EVPUII = EVOL MANU  TAB1.GRAPH1.LIFL  TAB1.GRAPH1.LIFLUP  ;
   TITRE 'CONVECTIVE POWER';
   EVPUIC = EVOL MANU  'INC FLUX  ' TAB1.GRAPH1.LIFL
                      'PUIS CONV ' TAB1.GRAPH1.LIFLUC ;
   EVPOUIC = EVOL MANU  'INC FLUX ' TAB1.GRAPH1.LIFL
                        '% PUIS CONV ' TAB1.GRAPH1.POFLUC ;
   TITRE 'RADIATIVE POWER';
   EVPUIR = EVOL MANU  'INC FLUX' TAB1.GRAPH1.LIFL
                       'PUIS RAYO ' TAB1.GRAPH1.LIFLUR ;
   EVPOUIR = EVOL MANU  'INC FLUX' TAB1.GRAPH1.LIFL
                       '% PUIS RAYO ' TAB1.GRAPH1.POFLUR ;
   TITRE 'REPARTITION DES PUISSANCES ';
   EVPUIS = (EVPUII ET EVPUIC ET EVPUIR)  ;
   DESSIN EVPUIS LEGE MIMA TAC3  ;
   TITRE 'REPARTITION DES PUISSANCES EN %';
   EVPOUIS = (EVPOUIC ET EVPOUIR)  ;
   DESSIN EVPOUIS LEGE MIMA TAC3  ;
*
   TITRE 'CALC. WALL MAX FLUX';
   EVFLUPAR = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
                         'WALL FLUX' TAB1.GRAPH1.LIFLUM ;
   TITRE 'EV.WALL FLUX(Fi*W/D)';
   EVFLUEV = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
                        'WALL FLUX' TAB1.GRAPH1.LIFLUEV ;
   ICHOI = EXTR TAB1.'CHFCORRELATION' 1 ;
   SI ( EGA ICHOI 'TONG' )   ;
    TITRE TAB1. M_TONG       ;
   FINSI                     ;
   SI ( EGA ICHOI 'CELA' ) ;
    TITRE 'CELATA 94'       ;
   FINSI                   ;
   EVFLCRIT = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
                         'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
*jb
  SI  TAB1.M_TONGJB   ;
    TITRE '1.67*TONG75 CHF ';
    EVFLCRIT = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFLU
                         'WALL FLUX' TAB1.GRAPH1.FLUCRIT ;
    TITRE (CHAIN (EXTR TAB1.CHFCORRELATION 1)  ' CHF ');
    EVFLJB = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFLU
                   'WALL. FLUX'  TAB1.GRAPH1.FLUCRITJB  ;
  FINSI ;
*
   TITRE 'TEST CHF ';
  SI ( EXISTE TAB1 EVOTEST )  ;
      M_FIESS = MAXI ( TAB1.EVOTEST EXTR 'ABSC' ) ;
      SI ( EGA TAB1.HYPERVAP VRAI ) ;
       M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.DH ;
      SINON ;
       M_FWESS = M_FIESS * (TAB1.W_HEATED) / TAB1.D_MAQUETTE ;
      FINSI ;
      EVFCESS = EVOL MANU  'INC. FLUX' ( PROG M_FIESS )
           'WALL FLUX' ( PROG M_FWESS ) ;
   TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL')
                'V-LOCAL' (TAB1.'V_LOCAL')
                'P-LOCAL' (TAB1.'P_LOCAL');


      TAC3.4 = 'MARQ TRIB REGU'   ;
*jb
    SI TAB1.M_TONGJB ;
       TAC3.5 = 'MARQ CARR NOLI'   ;
       DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT
               ET EVFCESS )LEGE MIMA TAC3  ;
*jb
       TAB1.EVFLUPA1 = EVFLUPAR ;
       TAB1.EVFLUE1  = EVFLUEV  ;
       TAB1.EVFLJ1   = EVFLJB   ;
       TAB1.EVFLCRI1 = EVFLCRIT ;
       TAB1.EVFCES1  = EVFCESS  ;
    SINON ;
       DESSIN (EVFLUPAR ET EVFLUEV ET EVFLCRIT ET EVFCESS)
                                      LEGE MIMA TAC3  ;
       TAB1.EVFLUPA1 = EVFLUPAR ;
       TAB1.EVFLUE1  = EVFLUEV  ;
       TAB1.EVFLCRI1 = EVFLCRIT ;
       TAB1.EVFCES1  = EVFCESS  ;
    FINSI ;
   SINON  ;
    SI TAB1.M_TONGJB ;
       DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLJB ET EVFLCRIT
               ET EVFCESS )LEGE MIMA TAC3  ;
       TAB1.EVFLUPA1 = EVFLUPAR ;
       TAB1.EVFLUE1  = EVFLUEV  ;
       TAB1.EVFLJ1   = EVFLJB   ;
       TAB1.EVFLCRI1 = EVFLCRIT ;
       TAB1.EVFCES1  = EVFCESS  ;
    SINON;
       DESSIN ( EVFLUPAR ET EVFLUEV ET EVFLCRIT ) LEGE MIMA TAC3  ;
       TAB1.EVFLUPA1 = EVFLUPAR ;
       TAB1.EVFLUE1  = EVFLUEV  ;
       TAB1.EVFLCRI1 = EVFLCRIT ;
       TAB1.EVFCES1  = EVFCESS  ;
    FINSI ;
   FINSI    ;
   TITRE 'W/D P.F.';
   TAC3.1 = 'MARQ PLUS '   ;
   TAC3.2 = 'MARQ ETOI '   ;
   TAC3.3 = 'MARQ CROI '   ;
   TAC3.4 = 'MARQ TRIA '   ;
   TAC3.5 = 'MARQ TRIB '   ;

   EGEOPF = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
             'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUEV / TAB1.GRAPH1.LIFLU);
   TITRE 'MAX FE P.F.';
   EMEFPF = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
             'PEAKING_FACTOR' (TAB1.GRAPH1.LIFLUM / TAB1.GRAPH1.LIFLU);
   TAB1.FE_PF = EMEFPF ;
SI TAB1.LCAPKPC;
   TITRE '90% FE P.F.';
   E90PF = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
             'PEAKING_FACTOR' TAB1.GRAPH1.L90PF;
   TITRE '80% FE P.F.';
   E80PF = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
             'PEAKING_FACTOR' TAB1.GRAPH1.L80PF;
   TITRE '70% FE P.F.';
   E70PF = EVOL MANU  'INC. FLUX' TAB1.GRAPH1.LIFL
             'PEAKING_FACTOR' TAB1.GRAPH1.L70PF;
   TITRE MOTITR 'T-LOCAL' (TAB1.'T_LOCAL')
                'V-LOCAL' (TAB1.'V_LOCAL')
                'P-LOCAL' (TAB1.'P_LOCAL');
   DESSIN (E70PF ET E80PF ET E90PF ET EMEFPF ET EGEOPF)
   LEGE MIMA TAC3;
SINON ;
   DESSIN ( EMEFPF ET EGEOPF) LEGE MIMA TAC3;
FINSI ;
*jb
   TAB1.EMEFP1 = EMEFPF ;
   TAB1.EGEOP1 = EGEOPF ;
 FINSI  ;
FINSI  ;
TAB1.PPRLI1 = PRLI1 ;
MENAGE;
SI (NIVEAU >EG 4) ;
 MESS ' -------------------> exiting @PPERM';
FINSI ;
FINPROC;
DEBPROC PRINRAPH    CONTR1*MCHAML
                      MOD1*MMODEL
                     MAIL1/MAILLAGE
                  ;

MESS '-----------------------------------> entree dans PRINRAPH '    ;
* modifier de maniere a pouvoir entre en option
*- le maillage sur lequel on veut les contraintes principales
*- le maillage sur lequel on veut que seffectue le trace
*
*

DIM1 = VALEUR DIME                                                   ;
* test sur la dimension
SI (EGA DIM1 2)                                                      ;
                                  ;
SINON ;
  ERRE 'PRIN RAPH NE MARCHE QUE EN 2D';
FINSI;





* de toute facon, il faut depouiller objet modele apres objet modele
* sinon, plusieurs contraintes principales n'ont pas de sens.

CONTR2 = REDU CONTR1 MOD1 ;
CONTR1 = CONTR2  ;
CPRIN1 = PRIN CONTR1 MOD1 ;
STOT1 = EXTR MOD1 'MAIL' ;
* on peut depouiller en modulant la taille du vecteur par
* le module de la contrainte principale associee

*----------1
* on extrait les composantes de module et de cos directeurs
CHSI11 = EXCO CPRIN1 SI11 ;
CHCOX1 = EXCO CPRIN1 COX1 ;
CHCOY1 = EXCO CPRIN1 COY1 ;
CHCOZ1 = EXCO CPRIN1 COZ1 ;
CHSI22 = EXCO CPRIN1 SI22 ;
CHCOX2 = EXCO CPRIN1 COX2 ;
CHCOY2 = EXCO CPRIN1 COY2 ;
CHCOZ2 = EXCO CPRIN1 COZ2 ;

*on transforme les composantes en champs par point
CKSI11 = CHAN CHPO MOD1 CHSI11 ;
CKCOX1 = CHAN CHPO MOD1 CHCOX1 ;
CKCOY1 = CHAN CHPO MOD1 CHCOY1 ;
CKCOZ1 = CHAN CHPO MOD1 CHCOZ1 ;
CKSI22 = CHAN CHPO MOD1 CHSI22 ;
CKCOX2 = CHAN CHPO MOD1 CHCOX2 ;
CKCOY2 = CHAN CHPO MOD1 CHCOY2 ;
CKCOZ2 = CHAN CHPO MOD1 CHCOZ2 ;

*on renomme correctement les composantes
CLSI11 = NOMC SCAL CKSI11 ;
CLCOX1 = NOMC UX CKCOX1  ;
CLCOY1 = NOMC UY CKCOY1  ;
CLCOZ1 = NOMC UZ CKCOZ1  ;

CLSI22 = NOMC SCAL CKSI22 ;
CLCOX2 = NOMC UX CKCOX2  ;
CLCOY2 = NOMC UY CKCOY2  ;
CLCOZ2 = NOMC UZ CKCOZ2  ;

*CLSI11_P = CLSI11 * ( CLSI11 MASQUE SUPERIEUR 0. );
*CLSI11_N = CLSI11 * ( CLSI11 MASQUE INFERIEUR 0. );
*CLSI22_P = CLSI22 * ( CLSI22 MASQUE SUPERIEUR 0. );
*CLSI22_N = CLSI22 * ( CLSI22 MASQUE INFERIEUR 0. );
CLSI11_P = CLSI11 MASQUE SUPERIEUR 0. ;
CLSI11_N = CLSI11 MASQUE INFERIEUR 0. ;
CLSI22_P = CLSI22 MASQUE SUPERIEUR 0. ;
CLSI22_N = CLSI22 MASQUE INFERIEUR 0. ;

*on multiplie les cosinus directeurs par la norme -1 ou +1

CMCOX1P = CLSI11_P * CLCOX1 ;
CMCOY1P = CLSI11_P * CLCOY1 ;
CMCOZ1P = CLSI11_P * CLCOZ1 ;

CMCOX1N = CLSI11_N * CLCOX1 ;
CMCOY1N = CLSI11_N * CLCOY1 ;
CMCOZ1N = CLSI11_N * CLCOZ1 ;

CMCOX2P = CLSI22_P * CLCOX2 ;
CMCOY2P = CLSI22_P * CLCOY2 ;
CMCOZ2P = CLSI22_P * CLCOZ2 ;

CMCOX2N = CLSI22_N * CLCOX2 ;
CMCOY2N = CLSI22_N * CLCOY2 ;
CMCOZ2N = CLSI22_N * CLCOZ2 ;


* on cree des champs par point contenat toutes les composantes
CH1P = CMCOX1P + CMCOY1P + CMCOZ1P ;
CH1N = CMCOX1N + CMCOY1N + CMCOZ1N ;
CH2P = CMCOX2P + CMCOY2P + CMCOZ2P ;
CH2N = CMCOX2N + CMCOY2N + CMCOZ2N ;


* on cree le champs de vecteurs
COEF1 = 2.E-11 ;
COEF1 = .00017 ;
VVEC1P = VECT CH1P COEF1 'UX' 'UY' ROUGE ;
VVEC1N = VECT CH1N COEF1 'UX' 'UY' VERT  ;
VVEC2P = VECT CH2P COEF1 'UX' 'UY' ROUGE ;
VVEC2N = VECT CH2N COEF1 'UX' 'UY' VERT ;
WVEC1P = VECT (-1. * CH1P) COEF1 'UX' 'UY' ROUGE ;
WVEC1N = VECT (-1. * CH1N) COEF1 'UX' 'UY' VERT ;
WVEC2P = VECT (-1. * CH2P) COEF1 'UX' 'UY' ROUGE ;
WVEC2N = VECT (-1. * CH2N) COEF1 'UX' 'UY' VERT ;


SI (EXISTE MAIL1 ) ;
 TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET
 VVEC2N ET WVEC2P ET WVEC2N) MAIL1 ;
SINON ;
 TRAC (VVEC1P ET VVEC1N ET WVEC1P ET WVEC1N ET VVEC2P ET
 VVEC2N ET WVEC2P ET WVEC2N) STOT1 ;
FINSI ;



* maintenant , on peut diminuer la quantite d'information en
* ne donnant que les directions

*CH1 = CLCOX1 + CLCOY1 + CLCOZ1 ;
*CH2 = CLCOX2 + CLCOY2 + CLCOZ2 ;

*VVEC1 = VECT CH1 .00015 'UX' 'UY' TURQ ;
*VVEC2 = VECT CH2 .00015 'UX' 'UY' TURQ ;
*VVEC3 = VECT (-1. * CH1) .00015 'UX' 'UY' TURQ ;
*VVEC4 = VECT (-1. * CH2) .00015 'UX' 'UY' TURQ ;


*TRAC (VVEC1 ET VVEC2 ET VVEC3 ET VVEC4) CON3 ;
*TRAC (VVEC1 ET VVEC3) CON3 ;
*TRAC (VVEC2 ET VVEC4) CON3 ;



MESS '-----------------------------------> sortie  de  PRINRAPH '    ;
FINPROC ;


**** @PTRANS
'DEBPROC' @PTRANS TAB1*'TABLE'      ;
SI (NON (EXISTE TAB1 NISOV))  ;
 TAB1.NISOV = 7  ;
FINSI  ;
MESS '>PTRANS TAB1.NISOV' TAB1.NISOV ;
NIVEAU = TAB1.'NIVEAU' ;
SI (NIVEAU >EG 4 ) ;
MESS '---------------------------------> calling @PTRANS';
FINSI ;
ICORSA1 = 0  ;
IVALI1 = 1 ;
SI ( NON (EXISTE TAB1 VIEW_P ))                          ;
   TAB1.VIEW_P = TEXT '    '                              ;
   TEX2        = TEXT '    '                              ;
   SI ( EGA ( VALE DIME) 3 )                              ;
    TAB1.VIEW_P = 1.E8 -1.E8 1.E8                          ;
   FINSI                                                  ;
FINSI                                                      ;
C_ONT1 = TAB1.M_IL_CONTOUR                              ;
S_TOT1  = TAB1.M_ILLAGE_TOT                                 ;
*VIN    =  TAB1 . V_IN    RM 23.01.96   ;
VIN     = TAB1.V_LOCAL ;
TIN     =  TAB1 . T_IN                   ;
PIN     =  TAB1 . P_IN                  ;
TTAPE   =  TAB1 . T_TAPE                ;
YTWIST  =  TAB1 . TWIST_RATIO               ;
LAMBDA  =  TAB1 . 'LAMBDA'               ;
AMPLV1 = ( TAB1 . D_MAQUETTE ) / ( 2. *  TAB1.MAX_SOFL )  ;
VPAT1 =  TAB1.V_VPAT1                                      ;
FLUMOY1    = TAB1.V_FLUMOY1                                    ;
COTETF1 = TAB1.C_COTETF1                                   ;
SITETF1 = TAB1.C_SITETF1                                    ;
COTETR1 = TAB1.C_COTETR1                                   ;
SITETR1 = TAB1.C_SITETR1                                    ;
COTETC1 = TAB1.C_COTETC1                                   ;
SITETC1 = TAB1.C_SITETC1                                    ;
TAC8    = TABLE   TAB1.T_TAC8                            ;
TAC2   =  TABLE        ;
TAC2.1 = 'MARQ CROI REGU TITRE INC_POWER'          ;
TAC2.2 = 'MARQ PLUS REGU TITRE RAD_POWER'          ;
TAC2.3 = 'MARQ LOSA REGU TITRE CONV_POWER'          ;
*RM011098
si (existe tab1 points) ;
 ind1 = inde (tab1.points) ;
finsi ;



* on est dans @ptrans         *********************************************
SI ( TAB1.TRANSITOIRE    )            ;
*  TEMPS ;
* MESS '>>>>> 4.10 >>>>>>'                    ;
  VFPAT1  = TAB1.V_VPAT1 * (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  PHIZERO =  (EXTR TAB1.LIS_FLUX ( DIME TAB1.LIS_FLUX ));
  SI ( EXISTE TAB1 'LAMDAQ'  )                           ;
   SI ( EXISTE TAB1 'CENTRE_PLASMA'  )                   ;
    PUI1  = TAB1.V_FLUMOY1 * (TAB1 . B_HEATED) * (TAB1.WE_HEATED ) ;
   SINON                                                 ;
    PUI1  = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.WE_HEATED ) ;
   FINSI                                                 ;
  SINON                                                  ;
   PUI1  = TAB1.V_FLUMOY1 * (TAB1 . L_HEATED) * (TAB1.W_HEATED )  ;
  FINSI;
*  TMOY  = TAB1.'TETA'  ;
 IFIG =  0  ;
 IFIG =  IFIG + 1                                                ;
 TITRE  '-p' IFIG '-BILAN DES PUIS.' PHIZERO                        ;

DESSIN (   ( TAB1.'EFLUI' )
        ET ( TAB1.'EFLUR' )
        ET ( TAB1.'EFLUC' ) ) LEGE  TAC2                ;
*tc ajout d'un finsi au pif!!!!!!!!!!
'FINSI';
*
*
si (existe tab1 LI_POINT) ;
 TAB1.LIS_TEMP = TABLE             ;
 IPP1 = 0 ;
 REPETER BOUPO6 ((DIME TAB1.LI_POINT) + 1 );
  TAB1.LIS_TEMP . IPP1 = PROG;
  IPP1 = IPP1 + 1 ;
 FIN BOUPO6;
finsi ;

si (existe tab1 points) ;
 TAB1.LIS_TEMP = TABLE             ;
 TAB1.LIS_TEMP . 0. = PROG;
 REPETER BOUPO6 ;
  si (exis ind1 &BOUPO6) ;
   TAB1.LIS_TEMP . &BOUPO6 = PROG;
  sinon ;
   quitter BOUPO6 ;
  finsi ;
 FIN BOUPO6;
finsi ;

I_0 = -1                                                 ;
I_1 = I_0                                                 ;
LSORT1 = TAB1 .LI_SORT1                                  ;
LSORT2 = TAB1 .LI_SORT2                                 ;
SI ( NON (EXISTE TAB1 OPT_SORT2) )                     ;
  TAB1.OPT_SORT2 = MOT '    '                          ;
FINSI                                                  ;
EVTRT = EVOL MANU  ( PROG ) ( PROG )                         ;
PTT1 = PROG                                                  ;
II2 = 0                                                       ;
EVTTR1 = EVOL MANU  ( PROG 0. ) ( PROG 0. )                  ;
   TAC4    = TABLE                     ;
   ROUGE   = MOT '    '                ;
*   TAC4.1 = 'MARQ CROI REGU TITRE ROUGE'          ;
   TAC4.2 = 'MARQ PLUS REGU '          ;
   TAC4.3 = 'MARQ PLUS REGU '          ;
   TAC4.4 = 'MARQ ETOI REGU '          ;
   TAC4.5 = 'MARQ ETOI REGU '          ;
   TAC4.6 = 'MARQ CARR REGU '          ;
   TAC4.7 = 'MARQ CARR REGU '          ;
   TAC4.8 = 'MARQ LOSA REGU '          ;
   TAC4.9 = 'MARQ LOSA REGU '          ;
   TAC4.10 = 'MARQ TRIA REGU '          ;
   TAC4.11 = 'MARQ TRIA REGU '          ;
   TAC4.12 = 'MARQ TRIB REGU '          ;
   TAC4.13 = 'MARQ TRIB REGU '          ;
   TAC4.14 = 'MARQ CROI REGU '          ;
   TAC4.15 = 'MARQ CROI REGU '          ;
   TAC4.16 = 'MARQ PLUS REGU '          ;
   TAC4.17 = 'MARQ PLUS REGU '          ;
   TAC4.18 = 'MARQ ETOI REGU '          ;
   TAC4.19 = 'MARQ ETOI REGU '          ;
   TAC4.20 = 'MARQ CARR REGU '          ;
   TAC4.21 = 'MARQ CARR REGU '          ;
   TAC4.22 = 'MARQ LOSA REGU '          ;
   TAC4.23 = 'MARQ LOSA REGU '          ;
   TAC4.24 = 'MARQ TRIA REGU '          ;
   TAC4.25 = 'MARQ TRIA REGU '          ;
   TAC4.26 = 'MARQ TRIB REGU '          ;
   TAC4.27 = 'MARQ TRIB REGU '          ;
   TAC4.28 = 'MARQ PLUS REGU '          ;
REPETER BEXP1                                                ;
 I_1 = I_1 + 1                                                 ;
* MESS ' exploitation pas ' I_1                                ;
SI ( NON ( EXISTE TAB1 I_1  ) )                               ;
  QUITTER BEXP1                                              ;
FINSI                                                        ;
*
*--- EXTRACTION DES TEMP. AUX PTS DESIRES
*
* les 10 lignes suivantes sont assez délicates
* svp ne pas modifier sans l'avis de RM ou JS
 TE1  = EXCO 'T'  ( TAB1. I_1 . TEMPERATURE  )       ;
 TT1  = TAB1. I_1 . 'INSTANT'                        ;
 PTT1 = PTT1 ET ( PROG TT1  )                        ;
 IPP1 = 0                                            ;

 SI ( EXISTE TAB1 LI_POINT )                         ;
  REPETER BOUPO7 ( DIME TAB1.LI_POINT)               ;
   IPP1 = IPP1 + 1                                   ;
* rm 10/09/96      T_P1    = TEXT (EXTR IPP1 TAB1.LI_POINT);
     T_P1 =  text ('EXTR' IPP1 TAB1.LI_POINT)   ;
*     list (TYPE (T_P1)) ;
    SI (EGA T_P1 '_MAX')                             ;
     TMIP1 = MAXI TE1                                ;
    SINON                                            ;
     T_P3 = S_TOT1 'POIN' 'PROC' (T_P1)         ;
     TMIP1 = EXTR ( TAB1. I_1. TEMPERATURE ) 'T' T_P3;
    FINSI                                            ;
    TAB1.LIS_TEMP . IPP1 =
                 ( TAB1.LIS_TEMP . IPP1 ) ET ( PROG TMIP1 )    ;
   FIN BOUPO7                                                  ;
  FINSI                                                      ;
* autre syntaxe pour le meme resultat, RM011098
 si (existe tab1 points) ;
  repe boupo7 ;
   si (existe ind1 &boupo7) ;
    nom1 = ind1.&boupo7 ;
    poa1 = tab1.points.nom1 ;
    si (ega nom1 '_max');
     tmip1 = maxi te1                                ;
    sinon ;
     tmip1 = extr ( tab1. i_1. temperature ) 'T' poa1;
    finsi ;
    TAB1.LIS_TEMP . &boupo7 =
                 ( TAB1.LIS_TEMP . &boupo7 ) ET ( PROG TMIP1 )    ;
   sinon ;
    quitter boupo7 ;
   finsi ;
  fin boupo7;
 finsi ;
 ISORT1 = 0                                                  ;
 IS1 = 0                                                     ;
 REPETER BEXP2 ( DIME LSORT1 )                               ;
  IS1 = IS1 + 1                                              ;
  TS1 = EXTR LSORT1 IS1                                      ;
   SI ( TT1 EGA TS1 1.E-3  )                                 ;
    ISORT1 = 1                                               ;
    QUITTER BEXP2                                            ;
   FINSI                                                     ;
 FIN BEXP2                                                   ;
 ISORT2 = 0                                                  ;
 IS2 = 0                                                     ;

 REPETER BEXP3 ( DIME LSORT2 )                               ;
  IS2 = IS2 + 1                                              ;
  TS2 = EXTR LSORT2 IS2                                      ;
   SI ( TT1 EGA TS2 1.E-3  )                                 ;
     ISORT2 = 1                                             ;
    QUITTER BEXP3                                            ;
   FINSI                                                     ;
 FIN BEXP3  ;
*
 SI ( ISORT1 EGA 1   )                               ;
*
 FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1')        ;
 CHPX = EXCO SCAL ( VFPAT1 * ( COTETF1 ) ) UX      ;
 CHPY = EXCO SCAL ( VFPAT1 * ( SITETF1 ) ) UY      ;
 CHPT2 = @ET CHPX CHPY            ;
* changement de couleur possible des fleches du flux a la paroi
 ROUGE = 'ROUGE';
 VEC_22 = @VECADA CHPT2 ( FCOEF * -1. * AMPLV1  ) ROUGE  ;

 TAB1. V_VEC22 = VEC_22                         ;
 SI ( EGA I_1 0 )                                    ;
   HCONVT1 = HCON1                                ;
 SINON                                            ;
   HCONVT1 = EXCO 'H' ( TAB1. I_1 . COEFHCONV )      ;
 FINSI                                            ;
 TECA0 = ( REDU TE1 TAB1.LFLUX_CONV  )                       ;
 FCNV2  = ( TECA0  - TAB1.'TETA' )  *  HCONVT1           ;
 CHPCX = EXCO SCAL ( FCNV2 * ( COTETC1 ) ) UX      ;
 CHPCY = EXCO SCAL ( FCNV2 * ( SITETC1 ) ) UY      ;
 CHPCT = ( CHPCX @ET CHPCY  )           ;
 VEC_1 = @VECADA CHPCT (  1. * AMPLV1  )    ROUGE  ;
 TAB1. V_VEC1 = VEC_1                         ;
*
* trace sur le meme graphe des conditions thermohydrauliques a la paroi
* FLUX/1.E6, Temperatures/10.
*
 TITRE '-p' IFIG '- TIME AND PHI0  ' TT1  ( PHIZERO * FCOEF ) ;
 FLUITT1 = TAB1.V_FLUMOY1 * FCOEF                           ;
 LMARQ1  = MOTS 'LOSA' 'TRIA' 'TRIB' 'LOSA' 'TRIA' 'TRIB'        ;
 TAC2    = TABLE                                                 ;
 TAC2.1  = 'MARQ CARR REGU TITRE WALL_FLUX'                      ;
 EVFLC1  = EVOL VERT 'CHPO' (FCNV2/1.E6) SCAL TAB1.LFLUX_CONV_DESS;
 PLINT1  = EXTR EVFLC1 ABSC 1                                    ;
 EVETOT1 = EVFLC1 ;

 NB_FLUX = DIME TAB1.'L_QCHFW'                                   ;
 I1 = 0                                                          ;
 REPETER BOUC_CHF NB_FLUX                                        ;
  I1 = I1 + 1                                                    ;
  EVQCRI1 = EVOL VERT MANU PLINT1
     (PROG (DIME PLINT1) * ((EXTR TAB1.'L_QCHFW' I1)/1.E6))      ;
  EVETOT1 = EVETOT1 ET EVQCRI1                                   ;
  SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'TONG')                  ;
   NOM_CORR = TAB1.M_TONG                                        ;
  FINSI                                                          ;
  SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'BOWR')                  ;
   NOM_CORR = 'BOWRING72'                                        ;
  FINSI                                                          ;
  SI (EGA (EXTR TAB1.CHFCORRELATION I1) 'CELA')                  ;
   NOM_CORR = 'CELATA94'                                         ;
  FINSI                                                          ;
  TAC2.(I1 + 1 ) = CHAIN 'MARQ ' (EXTR LMARQ1 I1)
                                  ' REGU TITRE ' NOM_CORR        ;
 FIN  BOUC_CHF                                                   ;

 EVTC1   = EVOL ROUG 'CHPO' (TECA0/10.)  SCAL TAB1.LFLUX_CONV_DESS ;
 TAC2.(2 + I1 ) = 'MARQ CROI REGU TITRE WALL_TEMP'             ;
 EVETOT1 = EVETOT1 ET EVTC1                                    ;

 EVTONB = EVOL ROUG MANU PLINT1
                (PROG (DIME PLINT1) * (TAB1.V_TONB /10. ))   ;
 TAC2.(3 + I1) = 'MARQ ETOI REGU TITRE TONB'                 ;
 EVETOT1 = EVETOT1 ET EVTONB                                 ;

 MESS '>@PTRANS> THERMOHYDRAULICS AT T = ' TT1                    ;
 DESSIN EVETOT1 LEGE MIMA TAC2                               ;

  SI ( EXISTE TAB1 LFLUX_RAYO )                      ;
   HRAYOT1 = EXCO 'H' ( TAB1. I_1 . COEFHRAYO )       ;
   TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) )            ;
   FRAY2  = HRAYOT1 * ( TERA1  - (TAB1 . TEMP_RAYO))    ;
   CHPRX = EXCO SCAL ( FRAY2 * ( COTETR1 ) ) UX      ;
   CHPRY = EXCO SCAL ( FRAY2 * ( SITETR1 ) ) UY      ;
   CHPRT = ( CHPRX @ET CHPRY  )                        ;
*>>>>>>>> modif bonnefoi du 6/04/93
*   VER1 = VECT CHPRT ( AMPLV1  ) UX UY ROUG       ;
   VER1 = @VECADA CHPRT ( AMPLV1  )   ROUG   ;
   TAB1. V_VER1 = VER1                         ;
   EVTR1 = EVOL 'CHPO' ( TERA1 * 1.E5 ) SCAL (TAB1 . LFLUX_RAYO_DESS);
   EVFLR1  = EVOL 'CHPO' FRAY2  SCAL (TAB1 . LFLUX_RAYO_DESS)    ;
   TITRE '-p'IFIG '- EXT. SURF. T. PROFILE ' TT1 ( PHIZERO * FCOEF );
   TAC2.1 = 'MARQ CROI REGU TITRE RADIATIVE_FLUX'          ;
*js 050997   TAC2.3 = 'MARQ CARR REGU TITRE L_RAYO_TEMP'          ;
   TAC2.2 = 'MARQ CARR REGU TITRE L_RAYO_TEMP'          ;
   MESS '>@PTRANS> 32.1 ' ;
   DESSIN (EVFLR1 ET EVTR1  ) LEGE MIMA  TAC2 ;
  FINSI                                               ;
  TITRE '-p' IFIG '- ISOV. TEMP.' TT1 ( PHIZERO * FCOEF )   ;
* TRACER   TAB1.VIEW_P CACH
*           ( TAB1. I_1 . TEMPERATURE ) S_TOT1  C_ONT1;
  MESS '>@PTRANS> TEMP ISOVALUES   AT T = ' TT1                    ;
*>>>>>modif J.F. Salavy le 04/05/95 : ajout de la possibilite de
*>>>>>tracer avec echelle constante au cours du temps. Cette echelle
*>>>>>TAB1.LECHTR est une prog de 14 valeurs definie dans le jeu de
*>>>>>donnees en fonction de Tmin et Tmax
  SI ( EXISTE TAB1 LECHTR )                          ;
    MESS '>PTRANS 33.0>>>' ;
    TRACER   TAB1.LECHTR TAB1.VIEW_P CACH
           ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1
                                (  VEC_1 ET VER1 ET VEC_22 )  ;
  SINON ;
    MESS '>PTRANS 33.1>>>' ;
    TRACER CACH TAB1.VIEW_P TAB1.NISOV
           ( TAB1. I_1 . TEMPERATURE ) S_TOT1 C_ONT1
                                (  VEC_1 ET VER1 ET VEC_22 )  ;
  FINSI ;
  SI ( EXISTE TAB1 VIEW_P2 )                          ;
      MESS '>PTRANS 33.2>>>' ;
      TRAC  CACH TAB1.VIEW_P2 TAB1.NISOV
           ( TAB1.  I_1  . TEMPERATURE ) S_TOT1 C_ONT1
                                (  VEC_1 ET VER1 ET VEC_22 )  ;
  FINSI                                                      ;
 FINSI                                                     ;
 SI ( ISORT2 EGA 1   )                               ;
  II2 = II2 +  1                                       ;
*js 050997  II21 =  II2 * 2 - 1 + 1                                  ;
  II21 =  II2                                   ;
  MESS '>@PTRANS> RAD,TEMP PROFILE AT T = ' TT1 II2 II21             ;
*
  FCOEF = IPOL TT1 (TAB1.'PTF1') (TAB1.'PCF1')        ;
*
  SI ( EXISTE TAB1 LFLUX_RAYO )                      ;
   TITRE 'TIME' TT1 IFIG '- EXT. SURF. PROFILE '  ( PHIZERO * FCOEF );
   TERA1 = ( REDU TE1 (TAB1 . LFLUX_RAYO) )            ;
   EVTR1 = EVOL 'CHPO' ( TERA1  ) SCAL (TAB1 . LFLUX_RAYO_DESS);
   EVTTR1 = EVTTR1 ET EVTR1                                 ;
   SI ( EXISTE TAC4 II21 )                                ;
    TAC4.II21 = CHAINE TAC4.II21 ' TITRE ' TT1              ;
   FINSI                                                  ;
*   DESSIN  EVTTR1  LEGE MIMA  TAC4                   ;
  FINSI                                                   ;
 FINSI                                                     ;
FIN BEXP1                                               ;
MESS ' end of the loop on the time to process  '       ;
  TTTTT1 = TEXT 'DESSIN EVTTR1 ' (TAB1.OPT_SORT2)
                                           'LEGE MIMA  TAC4 ' ;
  TTTTT1                                                          ;
*  DESSIN  EVTTR1 (TAB1.OPT_SORT2) LEGE MIMA   TAC4 ;
*
 TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO  ;
 IPP8 = 0                                    ;
 LIST1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA
              CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA
              CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
*js250796 TAC8 = TABLE                                              ;
SI ( EXISTE TAB1 LI_POINT )                                ;
 REPETER BOUPO8 ( DIME TAB1.LI_POINT  )                       ;
  IPP8 = IPP8 + 1                                   ;
   MARQ1   = EXTR IPP8 LIST1;
   N_P1    = EXTR IPP8 TAB1.LI_POINT ;
   TAC8.IPP8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1       ;
   TITRE N_P1  ' TEMP CALCULATION '      ;
   TAB1.EVT1 = EVOL MANU  '  ' PTT1  'TEMPERATURE'
           TAB1. LIS_TEMP . IPP8       ;
   SI ( IPP8 EGA 1 )                                     ;
    TAB1.EVTTT1 = TAB1.EVT1                                ;
   SINON                                                 ;
    TAB1.EVTTT1 = TAB1.EVTTT1 ET  TAB1.EVT1   ;
   FINSI                                                        ;
 FIN BOUPO8     ;
 MESS '>@PTRANS>    >>> 5 >>>>>>>'                 ;
 TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
*
 IFIG =  IFIG   + 1                 ;
 TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO  ;
 SI ( NON (EXISTE TAB1 OPT_CADPT) )                     ;
  TAB1.OPT_CADPT = MOT '    '                          ;
 FINSI                                                  ;

* EVTR2 =   EVT1  * 0. ;
* EVTTT1 = ( EVTTT1 ET EVTR2 ) ;
* DESSIN   EVTTT1 LEGE    MIMA  TAC8 ;
  TTTTT1 = TEXT 'DESSIN  TAB1.EVTTT1 ' (TAB1.OPT_CADPT)
                                         'LEGE MIMA  TAC8 ' ;
  TTTTT1                                                     ;
 MESS '>@PTRANS>   >>> 6 >>>>>>>'                 ;
FINSI                                   ;
si (existe tab1 points) ;
 repe boupo8 ;
  si (existe ind1 &boupo8) ;
   marq1   = extr &boupo8 LIST1;
   n_p1    = ind1.&boupo8 ;
   TAC8.&boupo8 = CHAINE 'MARQ ' MARQ1 ' REGU TITR ' N_P1       ;
   TITRE N_P1  ' TEMP CALCULATION '      ;
   TAB1.EVT1 = EVOL MANU  '  ' PTT1  'TEMPERATURE'
           TAB1. LIS_TEMP . &boupo8       ;
   SI ( &boupo8 EGA 1 )                                     ;
    TAB1.EVTTT1 = TAB1.EVT1                                ;
   SINON                                                 ;
    TAB1.EVTTT1 = TAB1.EVTTT1 ET  TAB1.EVT1   ;
   FINSI                                                        ;
  sinon ;
   quitter boupo8 ;
  finsi ;
 fin boupo8 ;
 MESS '>@PTRANS>    >>> 5 >>>>>>>'                 ;
 TITRE '-P' IFIG '- PROFIL T. SURF. EXT.' PHIZERO;
 IFIG =  IFIG   + 1                 ;
 TITRE '-P' IFIG '- EVOL. T. SURF.' PHIZERO  ;
 SI ( NON (EXISTE TAB1 OPT_CADPT) )                     ;
  TAB1.OPT_CADPT = MOT '    '                          ;
 FINSI                                                  ;
 TTTTT1 = TEXT 'DESSIN  TAB1.EVTTT1 ' (TAB1.OPT_CADPT)
                                         'LEGE MIMA  TAC8 ' ;
 TTTTT1                                                     ;
 MESS '>@PTRANS>   >>> 6 >>>>>>>'                 ;
finsi ;
MESS '>>>>> 7 >>>>>>>'                                    ;
SI (NIVEAU >EG 4) ;
 MESS '---------------------------------> exiting @PTRANS';
FINSI ;
FINPROC         ;


DEBPROC RAMRES CONT1*MCHAML
                 MOD1*MMODEL
                MAIL1*MAILLAGE
                COMP1*MOT;

* calcul de la resultant d'un MCHAML


 CONTU1 = REDU (EXTR MOD1 MAIL)  CONT1;
 CONTU2 = PROI MAIL1 (CHAN NOEUD MOD1 CONTU1) ;

* CONTU2 = CHAN CHPO MOD1 (CHAN NOEUD MOD1 CONTU1) ;
* CONTU3 = REDU CONTU2 MAIL1 ;
* CONTU4 = CHAN CHAM CONTU2 MAIL1 NOEUD ;

 CONTU3 = CHAN CHAM CONTU2 MAIL1 NOEUD ;
 MODD1  = MODL MAIL1 MECANIQUE ELASTIQUE ISOTROPE ;
 VAL1   = INTG MODD1 CONTU3 COMP1 ;

* mettre une autre methode passat par REAC et
* que je trouve plus propre



FINPROC VAL1;

**** @RAPACQU
DEBPROC @RAPACQU NDON1*ENTIER NABSC1*ENTIER TAB1*TABLE;
MESS '--------------------------------> calling @RAPACQU';
I1 = 0 ;
REPETER BOUC1 NDON1 ;
 I1 = I1 + 1    ;
 TAB1.I1 = PROG ;
FIN BOUC1 ;

REPETER BOUC2 NABSC1;
 ACQU LR1*LISTREEL NDON1;
 I2 = 0 ;
 REPETER BOUC3 NDON1;
  I2 = I2 + 1 ;
  TAB1.I2 = TAB1.I2 ET (PROG (EXTR LR1 I2));
 FIN BOUC3;
FIN BOUC2 ;

MESS '--------------------------------> exiting @RAPACQU';
FINPROC ;




'DEBPROC' RDPGTHPL RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE
                 TE1*CHPOINT TABDEP1*TABLE                       ;
*----------------------------------------------------------------------*
*                                                                      *
*                             R D P G T H P L                               *
*                             ---------------                          *
*                                                                      *
*     RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN                 *
*     PB THERMOMECANIQUE                                               *
*                                                                      *
*                                                                      *
*     RIG10                 MATRICE DE RIGIDITE                        *
*     MAT1                  CHAMELEM DES MATERIAUX                     *
*  (  ASCU0  )               OBJET AFFECTE ( ELEMENTS FINIS )          *
*     TE1                   CHPOIN DE TEMPERATURE ( CHARGEMENT    )    *
*     TABDEP                TABLE                                      *
*     INDICE 'NZ'           EFFORT LONGITUDINAL IMPOSE                 *
*     INDICE 'TINI'         TEMPERATURE INITIALE                       *
*     INDICE 'LIG1'         LIGNE POUR APPLICATION CHARGEMENT BIDON    *
*     INDICE 'MX'           MOMENT EN X IMPOSE                         *
*     INDICE 'MY'           ...A PROGRAMMER SUIV. MOD. MX              *
*   ( INDICE 'PO')           CENTRE D'INERTIE DE VOTRE SURFACE         *
*   ( INDICE 'VX')          LE VX POUR SFXX = MXX/(IXX/VX)             *
*                                                                      *
*     EN SORTIE                                                        *
*     DE1                   CHPOINT DE DEPLACEMENT                     *
*     SIG1                  CONTRAINTES                                *
*                                                                      *
*     CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
*     SATISFACTION                                                     *
*     IL FAUDRAIT EN FAIRE UNE PROCEDURE                               *
*     ET LE TESTER CONVENABLEMENT                                      *
*                                                                      *
*     SCHLOSSER LE 13 9 90                                             *
*                                                                      *
*     SCHLOSSER LE 17 7 91                                             *
*                                                                      *
*     TABDEP1.'EPSI'  CHAMELEM DES DEFORMATIONS
*     TABDEP1.'RY'    RAYON DE COURBURE EN Y
*     TABDEP1.'EPZM'  DEFORMATION MOYENNE EN Z                         *
*   ( INDICE 'PO')           CENTRE DE L AXE NEUTRE                    *
*   ( INDICE 'VX')          LE VX POUR SFXX = MXX/(IXX/VX)             *
*----------------------------------------------------------------------*
*23456789012345678901234567890123456789012345678901234567890123456789012
*--------1---------2---------3---------4---------5---------6---------7-*
*******   CALCUL DES FORCES DUES AUX TEMPERATURES       **************
*
 MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>'   ;
 LISTE ( VALEUR 'MODE' )                       ;
SI ( EXISTE ASCU0 )                           ;
 ASCU1 =  ASCU0                               ;
SINON                                                   ;
 ASCU1 =  EXTR MAT1 'AFFE'                     ;
TITRE 'ASCU1';
TRACE ASCU1                                        ;
FINSI                                         ;
 MAIL_1 = EXTR ASCU1 'MAIL'                    ;
 TITRE 'MAIL_1';
 TRACE  MAIL_1                      ;
 IGENE   = 0                                  ;
 SI_10    = THETA   MAT1 ( TE1  - ( TABDEP1.TINI ) )    ;
 SIONE    = MANU    CHAM  ASCU1  CONTRAIN SMZZ 1.    ;
 SIERR    = MANU    CHAM  ASCU1  CONTRAIN SMZZ 0.    ;
 SECC     = EXTR  SI_10 'MAIL'     ;
 A_1      = 1.0                                      ;
 TOL_1    = 1.E-15                                    ;
 TOL_2    = 1.E-18                                   ;
 YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 )          ;
  SEC_1    = INTG SIONE SMZZ                          ;
  MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1      ;
 SI ( EXISTE TABDEP1 NZ )                            ;
  IGENE = IGENE + 1                                  ;
 FINSI                                           ;
 SI ( EXISTE TABDEP1 MX )                            ;
  IGENE = IGENE + 1                                  ;
  PO_1  = BARY SECC                                         ;
* L_Y1 = (( COOR 2 SECC  ) - ( COOR 2 PO_1 ) ) ;
  Y_1 =  COOR 2 SECC                           ;
  Y_2  = PRCH Y_1 ASCU1 STRESSES                            ;
  Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG  YG1 )         ;
  L_Y1 = ( Y_1 - Y_PO2  ) ;
  X_1 =  COOR 1 SECC                           ;
  X_2  = PRCH X_1 ASCU1 STRESSES                            ;
  X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG  YG1 )         ;
  L_X1 = ( X_1 - X_PO2  ) ;
  PO_2 = ( X_PO2 Y_PO2 )                             ;
  TABDEP1.PO  = PO_2                                            ;
  VX_1   = MAXI ( ABS  L_Y1 )               ;
  TABDEP1.VX = VX_1                                  ;
  L_Y  = PRCH L_Y1 ASCU1 STRESSES                            ;
  IXX_1    = INTG ( L_Y * L_Y )                       ;
  MESS ' VOTRE BARICENTRE                ' ( COOR 1 PO_1 )
                                           ( COOR 2 PO_1 )   ;
  MESS ' VOTRE CENTRE  D AXE NEUTRE      ' ( COOR 1 PO_2 )
                                           ( COOR 2 PO_2 )   ;
  MESS ' VOTRE         VX                ' VX_1       ;
  MESS ' VOTRE INERTIE IXX     A VERIFIER' IXX_1      ;
 FINSI                           ;
 IB = 0 ;
 TBB1  = TABLE   ;
 TBB1.CHPOTHETA   = TABLE   ;
 TBB1.PLASTIQUE = VRAI                         ;
 TBB1.THERMIQUE = VRAI                         ;
 TBB1.ITERATION = KSI                          ;
*TREFERENCE = 0.;
 TBB1.CHPOTHETA . 0. = 0. ;
 TBB1.CHPOTHETA .  1.  =
  (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI )))     ;
 VPREC    = 0.1                                      ;
 TBB1.MAXITERATION = 200                                    ;
 TBB1.ACCELERATION =  20        ;
 LIS1 = PROG 1. 1.              ;
 XF1  = PROG 0. 1.              ;
 F1   = FORCE FY 0. (TABDEP1.LIG1 )                 ;
 CHA1   = CHAR F1  ( EVOL MANU LIS1 XF1 )    ;
REPETER BODEPG 10                                    ;
 TBB1  = TABLE   ;
 TBB1.CHPOTHETA   = TABLE   ;
 TBB1.PLASTIQUE = VRAI                         ;
 TBB1.THERMIQUE = VRAI                         ;
 TBB1.ITERATION = KSI                          ;
*TREFERENCE = 0.;
 TBB1.CHPOTHETA . 0. = 0. ;
 TBB1.CHPOTHETA .  1.  =
  (TE1 - (MANU 'CHPO' MAIL_1 1 'T' ( TABDEP1.TINI )))     ;
 VPREC    = 0.1                                      ;
 TBB1.MAXITERATION = 200                                    ;
 TBB1.ACCELERATION =  20        ;
 IB = IB + 1 ;
 MESS 'IB = ' IB ;
 SI_11    = SI_10 - SIERR                          ;
 FO1    = BSIGMA SI_11                             ;
SI ( EXISTE TABDEP1 CHAMP )                        ;
 FO1   = FO1 ET ( TABDEP1 . CHAMP )                ;
FINSI                                              ;
*MESS ' >>>>>>>fin 1er bsigma  '                        ;
*
*******   CALCUL DE LA SOLUTION                         **************
*
 DE1    = RESOU  RIG10      FO1                  ;
 MESS ' >>>>>>>fin resou   '                        ;
* SI_12  = SIGMA  DE1    MAT1                    ;
* SI_13  = SI_12 - SI_11                              ;
 TBB1.SIGI= SIERR*(+1.)                           ;
 TBB1.PRECISION   = VPREC / IB                              ;
 NONLIN RIG10 MAT1  CHA1 LIS1   ASCU1 TBB1               ;
 SI_13  = TBB1.RESUCONT . 1.                      ;
 SI ( IB EGA 1 )                                      ;
*  MSM1   = MAXI ( ABS SI_13 )                         ;
  MSM1   = MAXI ( ABS SI_10 )                         ;
  SI ( MSM1  <EG 1.E-20 ) ; MSM1 = 1.E-20  ; FINSI             ;
 FINSI                                                ;
 DDD_1  = 0.                                         ;
 DDD_2  = 0.                                         ;
 SI ( EXISTE TABDEP1 NZ )                            ;
  FZ_1 =     INTG SI_13 SMZZ                          ;
  DFZ_1 =  ( TABDEP1.NZ ) - FZ_1                      ;
  DSZ_1 =  DFZ_1 / SEC_1                              ;
  DRZ_1 =  ( ABS DSZ_1 ) / MSM1                               ;
  MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1             ;
  MESS ' ERREUR RELATIVE SIGZZ----'   DRZ_1                   ;
  DDD_1  =  DDD_1 +  DRZ_1                             ;
  DDD_2  =  DDD_2 + ( ABS  DSZ_1 )                       ;
  SIERR    =   SIERR
  + ( MANU CHAM ASCU1 CONTRAIN SMZZ    ( A_1 * DSZ_1 ))  ;
  MESS ' >>>>>>>fin sierr1  '                        ;
 FINSI                                           ;
 SI ( EXISTE TABDEP1 MX )                            ;
  MX_1 =     INTG ( SI_13 * L_Y ) SMZZ                ;
  DMX_1 =  ( TABDEP1.MX ) - MX_1                       ;
  DSX_1 =  DMX_1 / IXX_1 * VX_1                       ;
  DRX_1 =  ( ABS DSX_1 ) / MSM1                               ;
  MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1        ;
  MESS ' ERREUR RELATIVE EN FLEXION SIGFX----'   DRX_1    ;
  DDD_1  =  DDD_1 + DRX_1                                      ;
  DDD_2  =  DDD_2 + ( ABS DSX_1 )                           ;
  SIERR    = SIERR + ( ( SIONE * L_Y ) *
                                      ( A_1 * DMX_1 / IXX_1 )) ;
  MESS ' >>>>>>>fin sierr2  '                        ;
 FINSI                                           ;
 SI ( IGENE EGA 0 ) ;
  QUITTER BODEPG ;
 MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE  '     ;
 MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN   '     ;
 FINSI             ;
 SI ( IB >EG 2 )                                  ;
  SI ( DDD_1 <EG TOL_1 ) ; QUITTER BODEPG ; FINSI             ;
  SI ( DDD_2 <EG TOL_2 ) ; QUITTER BODEPG ; FINSI             ;
 FINSI                                                        ;
 MESS ' >>>>>>>on reboucle   '                        ;
FIN BODEPG                                       ;
SIG1 = SI_13                                     ;
*ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 )          ;
*EPT    =       ALPH1 * ( PRCH TE1  ASCU1 'STRESSES' )   ;
ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 )          ;
EPT    = PRCH   (    TE1 *   ALPH1  )  ASCU1 'STRESSES' ;
*list EPT ;
ETXX   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT              ;
ETYY   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT            ;
ETZZ   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT           ;
CHEPS =  ( ELAS  SI_13  MAT1 ) +  ETXX + ETYY + ETZZ   ;
EPSZZ  = EXCO EPZZ CHEPS                           ;
EPZM  = ( INTG  EPSZZ ) / SEC_1                   ;
MESS '  VOTRE  EPZ MOYEN  :  '   EPZM                ;
EPBZ  =  EPSZZ - (( EPSZZ ** 0 ) * EPZM )               ;
SI ( EXISTE TABDEP1 MX )                            ;
 CHRY = L_Y   * ( EPBZ ** -1 ) * -1.               ;
 MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT '
   ( MAXI CHRY ) ( MINI CHRY )                             ;
 RY  = ( INTG CHRY ) /   SEC_1          ;
 TABDEP1.'RY'   =  RY                  ;
FINSI                                 ;
TABDEP1.'EPSI' =  CHEPS                  ;
TABDEP1.'EPZM' =  EPZM                 ;
FINPROC DE1 SIG1                                 ;
**** @REMOJET

DEBPROC @REMOJET XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT
                 PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;

*MESS '---------------------------------> calling @remojet';
*
IMETHOD = TAB1.<METHODE_REMONTEE ;
*
*---- Methode Explicite
SI (IMETHOD EGA 1) ;
   DEPX0 DEPY0 DEPZ0 = @DEXPJET XG_OLD2 YG_OLD2 ZG_OLD2
                                PAS0 TAB1;
SINON ;
   ERRE '>>> METHODE INDISPONIBLE' ;
FINSI ;
*
*---- On affecte le signe donnant le sens de remontee
*---- aux deplacements
DEPX0 = CHSIGN2 * DEPX0 ;
DEPY0 = CHSIGN2 * DEPY0 ;
DEPZ0 = CHSIGN2 * DEPZ0 ;
*
*---- Calcul analytique des nouvelles coordonnees dans le
*---- repere global
XG_NEW2 = XG_OLD2 + DEPX0 ;
YG_NEW2 = YG_OLD2 + DEPY0 ;
ZG_NEW2 = ZG_OLD2 + DEPZ0 ;
*
*---- actualisation de la position des points de la ligne
DEPX0 = NOMC UX DEPX0 NATURE DIFFUS ;
DEPY0 = NOMC UY DEPY0 NATURE DIFFUS ;
DEPZ0 = NOMC UZ DEPZ0 NATURE DIFFUS ;
DEP0  = DEPX0 ET DEPY0 ET DEPZ0 ;
*
*MESS '---------------------------------> exiting @remojet';
FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 DEP0 ;

**** @REMONTE

DEBPROC @REMONTE XG_OLD2*CHPOINT YG_OLD2*CHPOINT ZG_OLD2*CHPOINT
                 PAS0*FLOTTANT CHSIGN2*CHPOINT TAB1*TABLE ;

*MESS '---------------------------------> calling @remonte';
*

IMETHOD = TAB1.<METHODE_REMONTEE ;

*---- Appel de la procedure de calcul des deplacements selon methode choisie
*---- Methode Explicite
 SI (IMETHOD EGA 1) ;
  DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 TAB1;
 FINSI ;
*---- Methode Euler-Cauchy
 SI (IMETHOD EGA 2) ;
  DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
 FINSI ;
*---- Methode Point Milieu Modifiee
 SI (IMETHOD EGA 3) ;
  DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
 FINSI ;
*---- Methode de Reprojection
 SI (IMETHOD EGA 4) ;
  DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD2 YG_OLD2 ZG_OLD2 PAS0 CHSIGN2 TAB1;
 FINSI ;

*---- On affecte le signe donnant le sens de remontee aux deplacements
 DEPX0 = CHSIGN2 * DEPX0 ;
 DEPY0 = CHSIGN2 * DEPY0 ;
 DEPZ0 = CHSIGN2 * DEPZ0 ;

*---- Calcul analytique des nouvelles coordonnees dans le repere global

 XG_NEW2 = XG_OLD2 + DEPX0 ;
 YG_NEW2 = YG_OLD2 + DEPY0 ;
 ZG_NEW2 = ZG_OLD2 + DEPZ0 ;

*MESS '---------------------------------> exiting @remonte';
FINPROC XG_NEW2 YG_NEW2 ZG_NEW2 ;

**** @repere
debproc @repere flot1*entier ;
o1 = 0. 0. 0. ;
32taa1 = table ;
32tab1 = table ;
32tac1 = table ;

repe bouc1 10 ;
 32taa1.&bouc1 = &bouc1 0. 0. ;
 32tab1.&bouc1 = 0. &bouc1 0. ;
 32tac1.&bouc1 = 0. 0. &bouc1 ;
 si (ega &bouc1 1 ) ;
  geo1 = ((o1 d 1 32taa1.&bouc1) coul jaun) et
         ((o1 d 1 32tab1.&bouc1) coul bleu) et
         ((o1 d 1 32tac1.&bouc1) coul vert) ;
 sinon ;
  geo1 = geo1 et
  ((32taa1.(&bouc1 - 1) d 1 32taa1.&bouc1) coul jaun) et
  ((32tab1.(&bouc1 - 1) d 1 32tab1.&bouc1) coul bleu) et
  ((32tac1.(&bouc1 - 1) d 1 32tac1.&bouc1) coul vert);

 finsi ;
fin bouc1;
geo2 = geo1 homo flot1 o1 ;


finproc geo1 ;


**** RESDPG
*-------------------------------------------------

'DEBPROC' RESDPG RIG10*RIGIDITE MAT1*CHAMELEM ASCU0/AFFECTE
                 TE1*CHPOINT TABDEP1*TABLE                       ;
*----------------------------------------------------------------------*
*                                                                      *
*                             R E S D P G                              *
*                             ---------------                          *
*                                                                      *
*     RESOLUTION EN DEFORMATION PLANE GENERALISEE D UN                 *
*     PB THERMOMECANIQUE                                               *
*                                                                      *
*                                                                      *
*     RIG10                 MATRICE DE RIGIDITE                        *
*     MAT1                  CHAMELEM DES MATERIAUX                     *
*  (  ASCU0  )               OBJET AFFECTE ( ELEMENTS FINIS )          *
*     TE1                   CHPOIN DE TEMPERATURE ( CHARGEMENT    )    *
*     TABDEP                TABLE                                      *
*     INDICE 'NZ'           EFFORT LONGITUDINAL IMPOSE                 *
*     INDICE 'MX'           MOMENT EN X IMPOSE                         *
*     INDICE 'MY'           ...A PROGRAMMER SUIV. MOD. MX              *
*   ( INDICE 'PO')           CENTRE D'INERTIE DE VOTRE SURFACE         *
*   ( INDICE 'VX')          LE VX POUR SFXX = MXX/(IXX/VX)             *
*                                                                      *
*     EN SORTIE                                                        *
*     DE1                   CHPOINT DE DEPLACEMENT                     *
*     SIG1                  CONTRAINTES                                *
*                                                                      *
*     CE JEU DE DONNEES A ETE UTILISE TEL QUE ET A SEMBLE DONNER
*     SATISFACTION                                                     *
*     IL FAUDRAIT EN FAIRE UNE PROCEDURE                               *
*     ET LE TESTER CONVENABLEMENT                                      *
*                                                                      *
*     SCHLOSSER LE 13 9 90                                             *
*                                                                      *
*     SCHLOSSER LE 17 7 91                                             *
*                                                                      *
*     TABDEP1.'EPSI'  CHAMELEM DES DEFORMATIONS
*     TABDEP1.'RY'    RAYON DE COURBURE EN Y
*     TABDEP1.'EPZM'  DEFORMATION MOYENNE EN Z                         *
*   ( INDICE 'PO')           CENTRE DE L AXE NEUTRE                    *
*   ( INDICE 'VX')          LE VX POUR SFXX = MXX/(IXX/VX)             *
*----------------------------------------------------------------------*
*
*******   CALCUL DES FORCES DUES AUX TEMPERATURES       **************
*
 MESS ' >>>>> ATTENTION VERIFIEZ QUE VOUS AVEZ PLAN DEFO >>>>>>>>'   ;
 LISTE ( VALEUR 'MODE' )                       ;
SI ( EXISTE ASCU0 )                           ;
 ASCU1 =  ASCU0                               ;
SINON                                         ;
 ASCU1 =  EXTR MAT1 'AFFE'                     ;
FINSI                                         ;
 IGENE   = 0                                  ;
 SI_10    = THETA   MAT1              TE1     ;
 SIONE    = MANU    CHAM  ASCU1  CONTRAIN SMZZ 1.    ;
 SIERR    = MANU    CHAM  ASCU1  CONTRAIN SMZZ 0.    ;
 SECC     = EXTR  SI_10 'MAIL'     ;
 A_1      = 1.0                                      ;
 TOL_1    = 1.E-15                                    ;
 TOL_2    = 1.E-18                                   ;
 YG1 = CHAN 'STRESSES' ( EXCO 'YOUNG' MAT1 )          ;
  SEC_1    = INTG SIONE SMZZ                          ;
  MESS ' VOTRE SURFACE SECTION A VERIFIER' SEC_1      ;
 SI ( EXISTE TABDEP1 NZ )                            ;
  IGENE = IGENE + 1                                  ;
 FINSI                                           ;
 SI ( EXISTE TABDEP1 MX )                            ;
  IGENE = IGENE + 1                                  ;
  PO_1  = BARY SECC                                         ;
* L_Y1 = (( COOR 2 SECC  ) - ( COOR 2 PO_1 ) ) ;
  Y_1 =  COOR 2 SECC                           ;
  Y_2  = PRCH Y_1 ASCU1 STRESSES                            ;
  Y_PO2 = ( INTG ( Y_2 * YG1 ) ) / ( INTG  YG1 )         ;
  L_Y1 = ( Y_1 - Y_PO2  ) ;
  X_1 =  COOR 1 SECC                           ;
  X_2  = PRCH X_1 ASCU1 STRESSES                            ;
  X_PO2 = ( INTG ( X_2 * YG1 ) ) / ( INTG  YG1 )         ;
  L_X1 = ( X_1 - X_PO2  ) ;
  PO_2 = ( X_PO2 Y_PO2 )                             ;
  TABDEP1.PO  = PO_2                                            ;
  VX_1   = MAXI ( ABS  L_Y1 )               ;
  TABDEP1.VX = VX_1                                  ;
  L_Y  = PRCH L_Y1 ASCU1 STRESSES                            ;
  IXX_1    = INTG ( L_Y * L_Y )                       ;
  MESS ' VOTRE BARICENTRE                ' ( COOR 1 PO_1 )
                                           ( COOR 2 PO_1 )   ;
  MESS ' VOTRE CENTRE  D AXE NEUTRE      ' ( COOR 1 PO_2 )
                                           ( COOR 2 PO_2 )   ;
  MESS ' VOTRE         VX                ' VX_1       ;
  MESS ' VOTRE INERTIE IXX     A VERIFIER' IXX_1      ;
 FINSI                                           ;
 IB = 0 ;
REPETER BODEPG 10                                    ;
 IB = IB + 1 ;
 MESS 'IB = ' IB ;
 SI_11    = SI_10 - SIERR                          ;
 FO1    = BSIGMA SI_11                             ;
SI ( EXISTE TABDEP1 CHAMP )                        ;
 FO1   = FO1 ET ( TABDEP1 . CHAMP )                ;
FINSI                                              ;
*MESS ' >>>>>>>fin 1er bsigma  '                        ;
*
*******   CALCUL DE LA SOLUTION                         **************
*
 DE1    = RESOU  RIG10      FO1                  ;
 MESS ' >>>>>>>fin resou   '                        ;
 SI_12  = SIGMA  DE1    MAT1                    ;
 SI_13  = SI_12 - SI_11                              ;
 SI ( IB EGA 1 )                                      ;
*  MSM1   = MAXI ( ABS SI_13 )                         ;
  MSM1   = MAXI ( ABS SI_10 )                         ;
  SI ( MSM1  <EG 1.E-20 ) ; MSM1 = 1.E-20  ; FINSI             ;
 FINSI                                                ;
 DDD_1  = 0.                                         ;
 DDD_2  = 0.                                         ;
 SI ( EXISTE TABDEP1 NZ )                            ;
  FZ_1 =     INTG SI_13 SMZZ                          ;
  DFZ_1 =  ( TABDEP1.NZ ) - FZ_1                      ;
  DSZ_1 =  DFZ_1 / SEC_1                              ;
  DRZ_1 =  ( ABS DSZ_1 ) / MSM1                               ;
  MESS ' ERREUR ABSOLU SIGZZ------' DSZ_1             ;
  MESS ' ERREUR RELATIVE SIGZZ----'   DRZ_1                   ;
  DDD_1  =  DDD_1 +  DRZ_1                             ;
  DDD_2  =  DDD_2 + ( ABS  DSZ_1 )                       ;
  SIERR    =   SIERR
  + ( MANU CHAM ASCU1 CONTRAIN SMZZ
                                     ( A_1 * DFZ_1 / SEC_1 ))  ;
  MESS ' >>>>>>>fin sierr1  '                        ;
 FINSI                                           ;
 SI ( EXISTE TABDEP1 MX )                            ;
  MX_1 =     INTG ( SI_13 * L_Y ) SMZZ                ;
  DMX_1 =  ( TABDEP1.MX ) - MX_1                       ;
  DSX_1 =  DMX_1 / IXX_1 * VX_1                       ;
  DRX_1 =  ( ABS DSX_1 ) / MSM1                               ;
  MESS ' ERREUR ABSOLU EN FLEXION SIGFX------' DSX_1        ;
  MESS ' ERREUR RELATIVE EN FLEXION SIGFX----'   DRX_1    ;
  DDD_1  =  DDD_1 + DRX_1                                      ;
  DDD_2  =  DDD_2 + ( ABS DSX_1 )                           ;
  SIERR    = SIERR + ( ( SIONE * L_Y ) *
                                      ( A_1 * DMX_1 / IXX_1 )) ;
  MESS ' >>>>>>>fin sierr2  '                        ;
 FINSI                                           ;
 SI ( IGENE EGA 0 ) ;
  QUITTER BODEPG ;
 MESS ' >>>>>>>AUCUNE CONDITION DE DEFO GENE  '     ;
 MESS ' >>>>>>>CALCUL EFFECTUE EN PLAN   '     ;
 FINSI             ;
 SI ( IB >EG 2 )                                  ;
  SI ( DDD_1 <EG TOL_1 ) ; QUITTER BODEPG ; FINSI             ;
  SI ( DDD_2 <EG TOL_2 ) ; QUITTER BODEPG ; FINSI             ;
 FINSI                                                        ;
 MESS ' >>>>>>>on reboucle   '                        ;
FIN BODEPG                                       ;
SIG1 = SI_13                                     ;
*ALPH1 = CHAN 'STRESSES' ( EXCO 'ALPH' MAT1 )          ;
*EPT    =       ALPH1 * ( PRCH TE1  ASCU1 'STRESSES' )   ;
ALPH1 = CHAN 'CHPO' ( EXCO 'ALPH' MAT1 )          ;
EPT    = PRCH   (    TE1 *   ALPH1  )  ASCU1 'STRESSES' ;
*list EPT ;
ETXX   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPXX' EPT              ;
ETYY   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPYY' EPT            ;
ETZZ   = MANU 'CHAM' ASCU1 'DEFORMAT' 'EPZZ' EPT           ;
CHEPS =  ( ELAS  SI_13  MAT1 ) +  ETXX + ETYY + ETZZ   ;
EPSZZ  = EXCO EPZZ CHEPS                           ;
EPZM  = ( INTG  EPSZZ ) / SEC_1                   ;
MESS '  VOTRE  EPZ MOYEN  :  '   EPZM                ;
EPBZ  =  EPSZZ - (( EPSZZ ** 0 ) * EPZM )               ;
SI ( EXISTE TABDEP1 MX )                            ;
 CHRY = L_Y   * ( EPBZ ** -1 ) * -1.               ;
 MESS ' MAXI MINI DE VOTRE RY QUI DEVRAIT ETRE CONSTANT '
   ( MAXI CHRY ) ( MINI CHRY )                             ;
 RY  = ( INTG CHRY ) /   SEC_1          ;
 TABDEP1.'RY'   =  RY                  ;
FINSI                                 ;
TABDEP1.'EPSI' =  CHEPS                  ;
TABDEP1.'EPZM' =  EPZM                 ;
FINPROC DE1 SIG1                                 ;
**** @resflux
debproc @resflux   cht1*chpoint
                   geo1*maillage
                   geo2*maillage
                lambda1/flottant
                  cara1/mchaml
                   mod1*mmodel ;
mess '---------------------------------> calling @RESFLUX';
v1 = vale dime ;
*
* --- calcul du flux
*
si (exis lambda1) ;
 lambda2 = lambda1 ;
sinon ;
 si (exis cara1)  ;
  lambda2 = vari nuag mod1 (redu cara1 mod1) cht1 ;
  lambda3 = chan chpo lambda2 mod1 ;
  lambda4 = chan attribut lambda3 nature discret ;
  lambda5 = exco lambda4 'K' ;
  lambda1 = lambda5 ;
 sinon ;
  erre '>@resflux> NO CONDUCTIVITY' ;
 finsi ;
finsi ;

gradt1   = grad cht1 mod1 ;
gradt2   = chan chpo gradt1 mod1 ;
gradt3   = chan attribut gradt2 nature discret ;
gradt4   = gradt3 * lambda1   ;
*
* --- calcul des normales
*
cosdir1 cosdir2 cosdir3 = @vnorm3d geo2 geo1 ;
cosdir1 = chan attribut cosdir1 nature discret ;
cosdir2 = chan attribut cosdir2 nature discret ;
cosdir3 = chan attribut cosdir3 nature discret ;
*
* --- produit scalaire
*
si (ega v1 2) ;
 mess '>@resflux> 2D value in (W/m)' ;
 flux1 = ((cosdir1 * (exco gradt4 'T,X')) +
          (cosdir2 * (exco gradt4 'T,Y')) );
sinon ;
 mess '>@resflux> 3D value in (W)' ;
 flux1 = ((cosdir1 * (exco gradt4 'T,X')) +
          (cosdir2 * (exco gradt4 'T,Y')) +
          (cosdir3 * (exco gradt4 'T,Z')) );
finsi ;
*
* --- intégration
*
flux2   = chan cham geo1 flux1 noeud ;
puis1   = intg (modl geo1 thermique isotrope) flux2;
puis1   = abs puis1;
*
* --- affichage et fin
*
mess '>@resflux> Power through ligne or surface :' puis1 ;
mess '---------------------------------> exiting @RESFLUX';
finproc puis1 ;
**** RESI
*************************************************************
*      PROCEDURE RESI : CALCUL D'UNE RESISTANCE
*************************************************************
DEBPROC RESI TAB1*TABLE ;
*************************************************************
*      MODELE
*************************************************************
MOD1 = TABLE ;
MAT1 = TABLE ;
COND1 = TABLE ;
TMAIL = TAB1.MAILLAGE ;
TCOND = TAB1.CONDUCT ;
TELEC = TAB1.ELECTRO ;
I = 0 ;
REPETER BOUC1 100 ;
I = I + 1 ;
SI (EXIS TMAIL I) ;
 MOD1.I = MODL TMAIL.I THERMIQUE ISOTROPE ;
 MAT1.I = MATR MOD1.I 'K' TCOND.I ;
 COND1.I = COND MOD1.I MAT1.I ;
SINON ;
 QUITTER BOUC1 ;
FINSI ;
FIN BOUC1 ;
N1 = I - 1 ;
MESS 'NOMBRE DE MATERIAUX DIFFERENTS :' N1 ;
*MESS 'CONDUCTIVITES :' ;
*LIST COND1 ;
****************************************************************
*     CONDITIONS AUX LIMITES
*****************************************************************
T1 = 1. ;
T2 = 0. ;
EL1 = TELEC.1 ;
EL2 = TELEC.2 ;
CL1 = BLOQUE T EL1 ;
CL2 = BLOQUE T EL2 ;
TI1 = DEPI CL1 T1 ;
TI2 = DEPI CL2 T2 ;
***************************************************************
*     CHARGEMENT
***************************************************************
COUR = TI1 ET TI2 ;
*****************************************************************
*     RESOLUTION
*****************************************************************
AMP1 = 5.E-3 ;
I = 0 ;
REPETER BOUC2 N1 ;
I = I + 1 ;
SI (EGA I 1);
 CONDT = COND1.1 ;
 MOD1T  = MOD1.I ;
 TCONDT = MANU CHPO  TMAIL.I 1 SCAL TCOND.I ;
 UNIT   = MANU CHPO  TMAIL.I 1 SCAL  1.     ;

SINON ;
 CONDT = CONDT ET COND1.I ;
 MOD1T  = MOD1T  ET  MOD1.I ;
 TCONDT =TCONDT ET ( MANU CHPO  TMAIL.I 1 SCAL TCOND.I );
 UNIT   =UNIT   ET ( MANU CHPO  TMAIL.I 1 SCAL  1. )    ;
FINSI ;
TCONDT = TCONDT / UNIT  ;
FIN BOUC2 ;
GEO = EXTR CONDT MAIL ;
RIG1 = CONDT ET CL1 ET CL2 ;
TEMP1 = RESOU RIG1 COUR ;
IDIM = VALEUR DIME ;
SI (EGA IDIM 2) ;
* TRAC TEMP1 GEO (CONT GEO) ;
SINON ;
 OEIL1 = 1.E4 1.E4 1.E4 ;
* TRAC OEIL1 TEMP1 GEO (ENVE GEO) ;
FINSI ;
TAB1.GRADIENT =  TABLE ;
GRAD1 = TAB1.GRADIENT ;
I = 0 ;
REPETER BOUC3 N1 ;
I = I + 1 ;
TEMPI = REDU TEMP1 TMAIL.I ;
GRAD1.I = (CHAN CHPO MOD1.I ( GRAD MOD1.I TEMPI )) *
(-1. * TCOND.I) ;
SI (EGA I 1);
 MOD1T  = MOD1.I ;
 TMAILT = TMAIL.I ;
 GRADT = GRAD1.1 ;
SINON ;
 MOD1T  = MOD1T  ET  MOD1.I ;
 TMAILT = TMAILT ET  TMAIL.I ;
 GRADT = GRADT ET GRAD1.I ;
FINSI ;
FIN BOUC3 ;
*GRADT = (CHAN CHPO MOD1T ( GRAD MOD1T TEMP1 )) *
*(-1. * TCOND.I) ;
 GRADT = GRADT / UNIT    ;
***************************************************
*******
*    CALCUL DU FLUX
*****************************************************************
I = 0 ;
TCH = EXTR GRADT COMP ;
TCH1 = EXTR TCH 1 ;
TCH2 = EXTR TCH 2 ;
**CHX = EXCO TCH1 GRADT JX ;
**CHY = EXCO TCH2 GRADT JY ;
 SI (EGA IDIM 3) ;
   J1 = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY )
                 ET ( EXCO TCH3 GRADT JZ ) ;
 SINON ;
   SI (EGA (VALEUR MODE) AXIS) ;
    MESS ' CALCUL EN AXISYMETRIQUE' ;
    MESS ' LA DENSITE DE COURANT EST DONNEE PAR RADIAN' ;
    CHR = COOR 1 GEO ;
*    CCHR = EXTR CHR COMP ;
*    LCHR = MOTS CCHR.1 ;
*    LCHX = MOTS JX ;
*    LCHY = MOTS JY ;
*    CHX = PSCA CHX CHR LCHX LCHR ;
*    CHY = PSCA CHY CHR LCHY LCHR ;
*    CHX = NOMC JX CHX ;
*    CHY = NOMC JY CHY ;
*    J1 = CHX ET CHY ;
*    J1 = ( ( EXCO TCH1 GRADT JX ) * CHR )
*            ET  ( ( EXCO TCH2 GRADT JY ) * CHR )  ;
    J1 = ( EXCO TCH1 GRADT JX )
           ET  ( EXCO TCH2 GRADT JY ) ;
  SINON ;
    J1  = ( EXCO TCH1 GRADT JX ) ET ( EXCO TCH2 GRADT JY ) ;
  FINSI ;
 FINSI ;
* SI (EGA IDIM 3) ;
*  CHZ = EXCO TCH3 GRADT JZ ;
*  J1 = J1 ET CHZ ;
* FINSI ;
REPETER BOUC9 N1 ;
I = I + 1 ;
SI (EGA IDIM 3) ;
  GRAD1.I = ( EXCO TCH1 GRAD1.I JX ) ET ( EXCO TCH2 GRAD1.I JY )
                 ET ( EXCO TCH3 GRAD1.I JZ ) ;
SINON ;
  SI (EGA (VALEUR MODE) AXIS) ;
   GRAD1.I = ( ( EXCO TCH1 GRAD1.I JX ) * CHR )
            ET  ( ( EXCO TCH2 GRAD1.I JY ) * CHR )  ;
  SINON ;
   GRAD1.I = ( EXCO TCH1 GRAD1.I JX )
                          ET ( EXCO TCH2 GRAD1.I JY ) ;
  FINSI  ;
FINSI  ;
FIN BOUC9 ;
GRAD2 = CHAM EL2 (REDU GRADT EL2) ;
GEO3 = GEO ELEM APPUYE LARGEMENT EL2 ;
MODE3 = MODL GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
SI (EGA IDIM 2) ;
MODE3 = MODL GEO3 MECANIQUE ELASTIQUE COQ2 TRI3 TRI6 QUA4 QUA8 ;
SINON ;
MODE3 = MODL GEO3 MECANIQUE ELASTIQUE CUB8 CU20 TET4 TE10
 PRI6 PR15 PYR5 PY13 ;
FINSI ;
CHP1 = PRES MASS MODE3 -1. EL2 ;
 TC1 = EXTR CHP1 COMP ;
 TC11 = EXTR TC1 1 ;
 TC12 = EXTR TC1 2 ;
 X1 = EXCO TC11 CHP1 SCAL ;
 Y1 = EXCO TC12 CHP1 SCAL ;
 ALPHA = ATG Y1 X1 ;
SI (EGA IDIM 2) ;
 CHXN = NOMC 'NX' (COS ALPHA) ;
 CHYN = NOMC 'NY' (SIN ALPHA) ;
 CHN = CHXN + CHYN ;
SINON ;
 TC13 = EXTR TC1 3 ;
 Z1 = EXCO TC13 CHP1 SCAL ;
 R1 = Y1/(SIN ALPHA) ;
 PHI ATG Z1 R1 ;
 CHXN = NOMC 'NX' ((COS PHI) * (COS ALPHA)) ;
 CHYN = NOMC 'NY' ((COS PHI) * (SIN ALPHA)) ;
 CHZN = NOMC 'NZ' (SIN PHI) ;
 CHN = CHXN + CHYN + CHZN ;
FINSI ;
CJ1 = EXTR J1 COMP ;
CJ11 = EXTR CJ1 1 ;
CJ12 = EXTR CJ1 2 ;
CCH1 = EXTR CHN COMP ;
CCH11 = EXTR CCH1 1 ;
CCH12 = EXTR CCH1 2 ;
SI (EGA IDIM 2) ;
 LJ1 = MOTS CJ11 CJ12;
 LCHN = MOTS CCH11 CCH12;
SINON;
 CJ13 = EXTR CJ1 3 ;
 CCH13 = EXTR CCH1 3 ;
 LJ1 = MOTS CJ11 CJ12 CJ13 ;
 LCHN = MOTS CCH11 CCH12 CCH13;
FINSI ;
*LIST LJ1 ;
*LIST LCHN ;
CHFLUX = PSCA J1 CHN LJ1 LCHN ;
CHAMFLUX = CHAN CHAM CHFLUX EL2;
MO1 = MODL EL2 THERMIQUE ISOTROPE ;
FLUX1 = INTG MO1 CHAMFLUX ;
*****************************************************************
*    CALCUL DE LA RESISTANCE
*****************************************************************
SI (EGA (VALEUR MODE) AXIS) ;
 PI = 3.14159 ;
 FLUX1 = FLUX1 * (2. * PI) ;
FINSI ;
RES1 = (T1 - T2) / FLUX1;
FINPROC TEMP1 J1 RES1 ;
*
DEBPROC  @RIPPL  TAB1*TABLE ;
*
***********************************************************
*      Version amelioree de la procedure RIPPLE           *
*               Alain MOAL (mai 1995)                     *
***********************************************************
*
OPTI ECHO 1  ;
SAUT 2 LIGNE ;
MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
*
*--------------- VARIABLES D'ENTREE :
RHO0     =  TAB1.<RPLASMA ;
RPLASMA  =  TAB1.<RPLASMA ;
THETA2   =  TAB1.<THETA2  ;
THETA1   =  TAB1.<THETA1  ;
COEF_A1  =  TAB1.<COEF_A1 ;
COEF_B1  =  TAB1.<COEF_B1 ;
COEF_C1  =  TAB1.<COEF_C1 ;
RZERO    =  TAB1.<R0      ;
RREF     =  TAB1.<RREF    ;
CONT1    =  TAB1.<CONT    ;
LSIN2T   =  TAB1.<CONTFIN ;
CONTFIN1 =  TAB1.<CONTFIN ;
PRHO     =  TAB1.<PRHO    ;
POINTTOP =  TAB1.<PTOP    ;
*------------------------------------
*---- nombre de bobines
NBOB  = 18.  ;
*
*---- l'utilite de ce masque ne m'apparait pas clairement
MASC1  = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
PRHO1  = PROG  ;
PDRHO1 = PROG  ;
PRHO2  = PROG  ;
PDRHO2 = PROG  ;
*
*---- coordonnees polaires dans Rref de l'enveloppe des lignes
*---- de champ dans le plan Phi = 0
PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) +
        ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
*
*---- demi-excursion radiale dans Rref
PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) *
        (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
*
*---- coordonnees polaires dans Rzero de l'enveloppe des lignes
*---- de champ dans le plan Phi = 0
PRHO1 = (((((RREF - RZERO)**2) * MASC1) +
        (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) +
        ((PRHO2)**2))**0.5)  ;
*
*---- demi-excursion radiale dans Rzero
PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
         PRHO1 *  PDRHO2  ;
*---- demi-excursion radiale dans Rzero
*TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
*TEST*         PRHO * PDRHO2  ;
*
*LIST PRHO1   ;
*LIST PDRHO1  ;
*
*---- coordonnees des noeuds du contour
XCONT1 = COOR 1 CONT1     ;
YCONT1 = COOR 2 CONT1     ;
XCONTF1 = COOR 1 CONTFIN1 ;
YCONTF1 = COOR 2 CONTFIN1 ;
*
*---- on doit utiliser un contour constitue de segments a
*---- 2 noeuds pour le calcul des abcisses curvilignes
CONT2 = CHAN SEG2 CONT1       ;
CONTFIN2 = CHAN SEG2 CONTFIN1 ;
*
*---- abscisse curviligne pour chaque noeud du contour
XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
*
*---- creation du champ a partir de la liste de reels
CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
*
*---- recherche du point extreme en X du contour on suppose
*---- qu'il est unique et que tous les X sont positifs
XEXT  = MAXI (XCONT1)                   ;
PEXT  = (XCONT1 POIN MAXI) POIN INITIAL ;
YEXT  = COOR 2 PEXT                     ;
*
LAM0  = RPLASMA - RHO0 ;
PLAM  = PROG LAM0      ;
PYPL1 = PROG 0.        ;
PXVE  = PROG 1.E-3     ;
PYVE  = PROG 0.        ;
I1 = 0                 ;
*
*---- Pour chaque enveloppe de ligne de champ
REPETER BOUCL (DIME PRHO1)                  ;
  I1 = I1 + 1                               ;
*TEST*   RHO1  = EXTR I1 PRHO               ;
  RHO1  = EXTR I1 PRHO1                     ;
  DRHO1 = EXTR I1 PDRHO1                    ;
*  MESS 'DRHO1 ' DRHO1                      ;
  DENS 3.E-3                                ;
* --- Creation de la ligne de champ
  S1 = 0.       (RPLASMA - RHO1)            ;
  S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  LSIN1 = S1 D S2                           ;
  XLS1 = COOR 1 LSIN1                       ;
* --- ancien calcul : valable si THETA1 est proche de 90 degres
*  DY1 = -1. *  DRHO1 *
*      (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
* --- calcul dans le cas general
* --- determination iterative de Phi et DY1
*  DY1_OLD = -1. * DRHO1 ;
*  I = 0 ;
*  IMAX = 50 ;
*  REPETER BOUCLE IMAX ;
*    I = I + 1 ;
*    PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
*    DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.)   ;
*    SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) <EG 1.E-6);
*       MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
*       QUITTER BOUCLE ;
*    FINSI ;
*    DY1_OLD = DY1_NEW ;
*  FIN BOUCLE ;
*  DY1 = DY1_NEW ;
* ---
  PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.)   ;
  DY2 = NOMC UY DY1                     ;
  LSIN2 = LSIN1 PLUS DY2                ;
* --- ligne contenant le contour et le sinus utilisee pour le trace
  LSIN2T = LSIN2T ET LSIN2              ;
*
* --------- CALCUL DU POINT D'INTERSECTION
  P_1 = LSIN2 POIN INITIAL              ;
*
  REPETER BOUCP 10                      ;
    EL_1 = ELEM LSIN2 CONTENANT P_1     ;
    P_11 = POIN 1 EL_1                  ;
    P_12 = POIN 2 EL_1                  ;
    XV1 = COOR 1 (P_11 MOIN P_12)       ;
    YV1 = COOR 2 (P_11 MOIN P_12)       ;
    XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
    YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
    DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
    PL_1 = (DIST POIN MINI) POIN INITIAL ;
    P_1OLD = P_1                        ;
    P_1 = LSIN2 POIN PROC PL_1          ;
*    TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
    SI (P_1OLD EGA P_1 0.3E-3)                       ;
      MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
      LIST PL_1                        ;
      QUITTER BOUCP                    ;
    FINSI                              ;
  FIN BOUCP                            ;
*
  MESS ' ON EST SORTI DE BOUCP '       ;
  X_11 = COOR 1 P_11                   ;
  X_12 = COOR 1 P_12                   ;
  SI ((X_12 - X_11) >EG 0.)            ;
    VEC_1 = P_12 MOIN P_11             ;
  SINON                                ;
    VEC_1 = P_11 MOIN P_12             ;
  FINSI                                ;
  YPL1 = COOR 2 PL_1                   ;
  XPL1 = COOR 1 PL_1                   ;
* ---- abscisse curviligne de ce point
  XC_PL_1 = MAXI (REDU CHXCURF PL_1)     ;
  PYPL1 = PYPL1 ET (PROG XC_PL_1)        ;
  PXVE = PXVE ET (PROG (COOR 1 VEC_1))   ;
  PYVE = PYVE ET (PROG (COOR 2 VEC_1))   ;
  PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
FIN BOUCL                                ;
*
*---- traitement du dernier point du contour
POINFIN = (INVE CONT1) POIN FINAL        ;
XC_FIN = MAXI (REDU CHXCUR POINFIN)      ;
PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
PXVE  = PXVE ET (PROG 1.E-3)             ;
PYVE  = PYVE ET (PROG 0.)                ;
DYMAX = -1. * (MAXI(ABS(YCONT1)))        ;
PLAM  = PLAM ET (PROG DYMAX)             ;
*
*------ Trace du contour et des lignes de champ
TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
TRAC LSIN2T                              ;
TITRE  'ABCISSE CURVILIGNE'                 ;
DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE)  ;
CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE)  ;
TITRE 'BETA'                                ;
BETA = ATG CHYVE CHXVE                      ;
DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA  ;
TITRE 'DISTANCE'                            ;
CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM)  ;
DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.<BETA = BETA  ;
TAB1.<DIST = CHDEL ;
*------------------------------------
*
SAUT 2 LIGNE ;
MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
FINPROC ;
*
DEBPROC  @RIPPL  TAB1*TABLE ;
*
***********************************************************
*     Version amelioree de l'ancienne procedure RIPPLE    *
*                 Alain MOAL (mai 1995)                   *
***********************************************************
*
OPTI ECHO 1  ;
SAUT 2 LIGNE ;
MESS ' ********** DEBUT DE LA PROCEDURE @RIPPL ***********' ;
*
*--------------- VARIABLES D'ENTREE :
RHO0     =  TAB1.<RPLASMA ;
RPLASMA  =  TAB1.<RPLASMA ;
THETA2   =  TAB1.<THETA2  ;
THETA1   =  TAB1.<THETA1  ;
COEF_A1  =  TAB1.<COEF_A1 ;
COEF_B1  =  TAB1.<COEF_B1 ;
COEF_C1  =  TAB1.<COEF_C1 ;
RZERO    =  TAB1.<R0      ;
RREF     =  TAB1.<RREF    ;
CONT1    =  TAB1.<CONT    ;
LSIN2T   =  TAB1.<CONTFIN ;
CONTFIN1 =  TAB1.<CONTFIN ;
PRHO     =  TAB1.<PRHO    ;
POINTTOP =  TAB1.<PTOP    ;
*------------------------------------
*---- nombre de bobines
NBOB  = 18.  ;
*
*---- l'utilite de ce masque ne m'apparait pas clairement
MASC1  = PRHO MASQUE EGSUPE (RPLASMA - 1.E-3) ;
PRHO1  = PROG  ;
PDRHO1 = PROG  ;
PRHO2  = PROG  ;
PDRHO2 = PROG  ;
*
*---- coordonnees polaires dans Rref de l'enveloppe des lignes
*---- de champ dans le plan Phi = 0
PRHO2 = ((RPLASMA * MASC1 * (SIN(THETA1)) / (SIN(THETA2))) +
        ((PRHO - (RPLASMA * MASC1)) / (COS(THETA1 - THETA2)))) ;
*
*---- demi-excursion radiale dans Rref
PDRHO2 = COEF_A1 * (EXP(COEF_B1 *PRHO2)) *
        (EXP(-1. * COEF_C1 * ((THETA2)**2))) ;
*
*---- coordonnees polaires dans Rzero de l'enveloppe des lignes
*---- de champ dans le plan Phi = 0
PRHO1 = (((((RREF - RZERO)**2) * MASC1) +
        (2 * (COS(THETA2)) * (RREF - RZERO) * PRHO2) +
        ((PRHO2)**2))**0.5)  ;
*
*---- demi-excursion radiale dans Rzero
PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
         PRHO1 *  PDRHO2  ;
*---- demi-excursion radiale dans Rzero
*TEST*PDRHO1 = (PRHO2 + (MASC1 * (COS(THETA2)) * (RREF - RZERO))) /
*TEST*         PRHO * PDRHO2  ;
*
*LIST PRHO1   ;
*LIST PDRHO1  ;
*
*---- coordonnees des noeuds du contour
XCONT1 = COOR 1 CONT1     ;
YCONT1 = COOR 2 CONT1     ;
XCONTF1 = COOR 1 CONTFIN1 ;
YCONTF1 = COOR 2 CONTFIN1 ;
*
*---- on doit utiliser un contour constitue de segments a
*---- 2 noeuds pour le calcul des abcisses curvilignes
CONT2 = CHAN SEG2 CONT1       ;
CONTFIN2 = CHAN SEG2 CONTFIN1 ;
*
*---- abscisse curviligne pour chaque noeud du contour
XCUR = EXTR (EVOL CHPO XCONT1 SCAL (INVE CONT1)) ABSC ;
XCURF = EXTR (EVOL CHPO XCONTF1 SCAL (INVE CONTFIN1)) ABSC ;
*
*---- creation du champ a partir de la liste de reels
CHXCUR = MANU CHPO (INVE CONT2) 1 SCAL XCUR ;
CHXCURF = MANU CHPO (INVE CONTFIN2) 1 SCAL XCURF ;
*
*---- recherche du point extreme en X du contour on suppose
*---- qu'il est unique et que tous les X sont positifs
XEXT  = MAXI (XCONT1)                   ;
PEXT  = (XCONT1 POIN MAXI) POIN INITIAL ;
YEXT  = COOR 2 PEXT                     ;
*
LAM0  = RPLASMA - RHO0 ;
PLAM  = PROG LAM0      ;
PYPL1 = PROG 0.        ;
PXVE  = PROG 1.E-3     ;
PYVE  = PROG 0.        ;
I1 = 0                 ;
*
*---- Pour chaque enveloppe de ligne de champ
REPETER BOUCL (DIME PRHO1)                  ;
  I1 = I1 + 1                               ;
*TEST*   RHO1  = EXTR I1 PRHO               ;
  RHO1  = EXTR I1 PRHO1                     ;
  DRHO1 = EXTR I1 PDRHO1                    ;
*  MESS 'DRHO1 ' DRHO1                      ;
  DENS 3.E-3                                ;
* --- Creation de la ligne de champ
  S1 = 0.       (RPLASMA - RHO1)            ;
  S2 = (XEXT + (XEXT/10.)) (RPLASMA - RHO1) ;
  LSIN1 = S1 D S2                           ;
  XLS1 = COOR 1 LSIN1                       ;
* --- ancien calcul : valable si THETA1 est proche de 90 degres
*  DY1 = -1. *  DRHO1 *
*      (COS(XLS1 * (NBOB / RZERO / 3.14159 * 180.)) - 1.) ;
* --- calcul dans le cas general
* --- determination iterative de Phi et DY1
*  DY1_OLD = -1. * DRHO1 ;
*  I = 0 ;
*  IMAX = 50 ;
*  REPETER BOUCLE IMAX ;
*    I = I + 1 ;
*    PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO + DY1_OLD));
*    DY1_NEW = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.)   ;
*    SI ((MAXI (ABS((DY1_NEW - DY1_OLD) / DY1_NEW))) <EG 1.E-6);
*       MESS ' NOMBRE D ITERATIONS DE POINT FIXE : ' I ;
*       QUITTER BOUCLE ;
*    FINSI ;
*    DY1_OLD = DY1_NEW ;
*  FIN BOUCLE ;
*  DY1 = DY1_NEW ;
* ---
  PHI = ATG (XLS1 / ((RHO1*(COS THETA1))+ RZERO)) ;
  DY1 = -1. * DRHO1 * ((COS(PHI * NBOB)) - 1.)   ;
  DY2 = NOMC UY DY1                     ;
  LSIN2 = LSIN1 PLUS DY2                ;
* --- ligne contenant le contour et le sinus utilisee pour le trace
  LSIN2T = LSIN2T ET LSIN2              ;
*
* --------- CALCUL DU POINT D'INTERSECTION
  P_1 = LSIN2 POIN INITIAL              ;
*
  REPETER BOUCP 10                      ;
    EL_1 = ELEM LSIN2 CONTENANT P_1     ;
    P_11 = POIN 1 EL_1                  ;
    P_12 = POIN 2 EL_1                  ;
    XV1 = COOR 1 (P_11 MOIN P_12)       ;
    YV1 = COOR 2 (P_11 MOIN P_12)       ;
    XV2 = (COOR 1 CONTFIN1) - (COOR 1 P_12);
    YV2 = (COOR 2 CONTFIN2) - (COOR 2 P_12);
    DIST =(ABS((YV2 * XV1) - (XV2 * YV1)))/(NORM (P_11 MOIN P_12));
    PL_1 = (DIST POIN MINI) POIN INITIAL ;
    P_1OLD = P_1                        ;
    P_1 = LSIN2 POIN PROC PL_1          ;
*    TRAC (CONTFIN1 ET ((P_11 D 1 P_12) COUL ROUG) ET PL_1 ET LSIN2);
    SI (P_1OLD EGA P_1 0.3E-3)                       ;
      MESS ' >>> ON TROUVE LE POINT D INTERSEC. << ' ;
      LIST PL_1                        ;
      QUITTER BOUCP                    ;
    FINSI                              ;
  FIN BOUCP                            ;
*
  MESS ' ON EST SORTI DE BOUCP '       ;
  X_11 = COOR 1 P_11                   ;
  X_12 = COOR 1 P_12                   ;
  SI ((X_12 - X_11) >EG 0.)            ;
    VEC_1 = P_12 MOIN P_11             ;
  SINON                                ;
    VEC_1 = P_11 MOIN P_12             ;
  FINSI                                ;
  YPL1 = COOR 2 PL_1                   ;
  XPL1 = COOR 1 PL_1                   ;
* ---- abscisse curviligne de ce point
  XC_PL_1 = MAXI (REDU CHXCURF PL_1)     ;
  PYPL1 = PYPL1 ET (PROG XC_PL_1)        ;
  PXVE = PXVE ET (PROG (COOR 1 VEC_1))   ;
  PYVE = PYVE ET (PROG (COOR 2 VEC_1))   ;
  PLAM = PLAM ET (PROG (RPLASMA - RHO1)) ;
FIN BOUCL                                ;
*
*---- traitement du dernier point du contour
POINFIN = (INVE CONT1) POIN FINAL        ;
XC_FIN = MAXI (REDU CHXCUR POINFIN)      ;
PYPL1 = PYPL1 ET (PROG (XC_FIN + (XC_FIN/10.))) ;
PXVE  = PXVE ET (PROG 1.E-3)             ;
PYVE  = PYVE ET (PROG 0.)                ;
DYMAX = -1. * (MAXI(ABS(YCONT1)))        ;
PLAM  = PLAM ET (PROG DYMAX)             ;
*
*------ Trace du contour et des lignes de champ
TITRE ' ENVELOPPES DES LIGNES DE CHAMP ' ;
TRAC LSIN2T                              ;
TITRE  'ABCISSE CURVILIGNE'                 ;
DESSIN (EVOL JAUN CHPO CHXCUR SCAL CONT1) MIMA ;
CHXVE = NOMC SCAL (IPOL CHXCUR PYPL1 PXVE)  ;
CHYVE = NOMC SCAL (IPOL CHXCUR PYPL1 PYVE)  ;
TITRE 'BETA'                                ;
BETA = ATG CHYVE CHXVE                      ;
DESSIN (EVOL JAUN CHPO BETA SCAL CONT1) MIMA  ;
TITRE 'DISTANCE'                            ;
CHDEL = NOMC SCAL (IPOL CHXCUR PYPL1 PLAM)  ;
DESSIN (EVOL JAUN CHPO CHDEL SCAL CONT1) MIMA ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.<BETA = BETA  ;
TAB1.<DIST = CHDEL ;
*------------------------------------
*
SAUT 2 LIGNE ;
MESS ' ********** FIN DE LA PROCEDURE @RIPPL ***********' ;
FINPROC ;
debproc @RMCOOR tab1*table ;

*
* R. Mitteau etude interseption
* 25/08/1998
*
mess '---------------------------------> calling @RMCOOR';
*
* --- variables d entree :
*
mail1    = tab1.<maillage       ;


* RM25/08/98 la il faudrait mettre un test pour verfier qu'on
* entre bien un maillage surfacique compose uniquement de tri3

*chpo des coordonnee des noeuds
chx1 = coor 1 mail1 ;
chy1 = coor 2 mail1 ;
chz1 = coor 3 mail1 ;

mod1 = modl mail1 mecanique elastique ;
*cham des coordonnees des noeuds
cex1 = chan cham chx1 mod1 noeud ;
cey1 = chan cham chy1 mod1 noeud ;
cez1 = chan cham chz1 mod1 noeud ;

nel1 = nbel mail1 ;
mess '>@RMCOOR> construction des champs
de coordonnees sur les ' nel1 ' elements';
* initialisation
chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
chamz3 = manu chml mod1 scal 0. stresses type scalaire ;

repe boucel1 nel1 ;
* mess &boucel1 ;

 cex1_1 = extr cex1 scal 1 &boucel1 1 ;
 cex1_2 = extr cex1 scal 1 &boucel1 2 ;
 cex1_3 = extr cex1 scal 1 &boucel1 3 ;

 cey1_1 = extr cey1 scal 1 &boucel1 1 ;
 cey1_2 = extr cey1 scal 1 &boucel1 2 ;
 cey1_3 = extr cey1 scal 1 &boucel1 3 ;

 cez1_1 = extr cez1 scal 1 &boucel1 1 ;
 cez1_2 = extr cez1 scal 1 &boucel1 2 ;
 cez1_3 = extr cez1 scal 1 &boucel1 3 ;

 chamx1 = chamx1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
 chamx2 = chamx2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
 chamx3 = chamx3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);

 chamy1 = chamy1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
 chamy2 = chamy2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
 chamy3 = chamy3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);

 chamz1 = chamz1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
 chamz2 = chamz2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
 chamz3 = chamz3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
fin boucel1 ;
*
* --- variables de sortie
*
tab1.<chamx1 = chamx1 ;
tab1.<chamy1 = chamy1 ;
tab1.<chamz1 = chamz1 ;
tab1.<chamx2 = chamx2 ;
tab1.<chamy2 = chamy2 ;
tab1.<chamz2 = chamz2 ;
tab1.<chamx3 = chamx3 ;
tab1.<chamy3 = chamy3 ;
tab1.<chamz3 = chamz3 ;


mess '---------------------------------> exiting @RMCOOR';
finproc ;

**** @RMCOORO

debproc @RMCOORO tab1*table ;

*
* R. Mitteau etude interseption
* 25/08/1998
*
mess '---------------------------------> calling @RMCOORO';
*
* --- variables d entree :
*
mail1    = tab1.<maillage       ;


* RM25/08/98 la il faudrait mettre un test pour verifier qu'on
* entre bien un maillage surfacique compose uniquement de tri3

* chpo des coordonnee des noeuds dans le repere du maillage
chxm1 = coor 1 mail1 ;
chym1 = coor 2 mail1 ;
chzm1 = coor 3 mail1 ;

* passage au repere global
chxg1 chyg1 chzg1 = @crmgc chxm1 chym1 chzm1 tab1;

mod1 = modl mail1 mecanique elastique ;
* cham des coordonnees des noeuds
cex1 = chan cham chxg1 mod1 noeud ;
cey1 = chan cham chyg1 mod1 noeud ;
cez1 = chan cham chzg1 mod1 noeud ;

nel1 = nbel mail1 ;
mess '>@RMCOORO> construction des champs
de coordonnees sur les ' nel1 ' elements';
* initialisation
chamx1 = manu chml mod1 scal 0. stresses type scalaire ;
chamx2 = manu chml mod1 scal 0. stresses type scalaire ;
chamx3 = manu chml mod1 scal 0. stresses type scalaire ;
chamy1 = manu chml mod1 scal 0. stresses type scalaire ;
chamy2 = manu chml mod1 scal 0. stresses type scalaire ;
chamy3 = manu chml mod1 scal 0. stresses type scalaire ;
chamz1 = manu chml mod1 scal 0. stresses type scalaire ;
chamz2 = manu chml mod1 scal 0. stresses type scalaire ;
chamz3 = manu chml mod1 scal 0. stresses type scalaire ;

repe boucel1 nel1 ;

 cex1_1 = extr cex1 scal 1 &boucel1 1 ;
 cex1_2 = extr cex1 scal 1 &boucel1 2 ;
 cex1_3 = extr cex1 scal 1 &boucel1 3 ;

 cey1_1 = extr cey1 scal 1 &boucel1 1 ;
 cey1_2 = extr cey1 scal 1 &boucel1 2 ;
 cey1_3 = extr cey1 scal 1 &boucel1 3 ;

 cez1_1 = extr cez1 scal 1 &boucel1 1 ;
 cez1_2 = extr cez1 scal 1 &boucel1 2 ;
 cez1_3 = extr cez1 scal 1 &boucel1 3 ;

 chamx1 = chamx1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_1);
 chamx2 = chamx2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_2);
 chamx3 = chamx3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cex1_3);

 chamy1 = chamy1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_1);
 chamy2 = chamy2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_2);
 chamy3 = chamy3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cey1_3);

 chamz1 = chamz1 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_1);
 chamz2 = chamz2 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_2);
 chamz3 = chamz3 +
 (manu cham mod1 type scalaire posi stresses scal &boucel1 1 cez1_3);
fin boucel1 ;
*
* --- variables de sortie
*
tab1.<chamx1 = chamx1 ;
tab1.<chamy1 = chamy1 ;
tab1.<chamz1 = chamz1 ;
tab1.<chamx2 = chamx2 ;
tab1.<chamy2 = chamy2 ;
tab1.<chamz2 = chamz2 ;
tab1.<chamx3 = chamx3 ;
tab1.<chamy3 = chamy3 ;
tab1.<chamz3 = chamz3 ;


mess '---------------------------------> exiting @RMCOORO';
finproc ;

**** @RMFLUN

debproc @RMFLUN tab1*table ;
************************************************************
* Procedure de calcul du flux normalise en chaque noeud de *
* chaque facette triangulaire d'un maillage (methode       *
* inspiree de @RMCOORO). Alain MOAL (Fevrier 2001)         *
************************************************************

mess '---------------------------------> calling @RMFLUN';
*
* --- variables d entree :
FLUN0 = TAB1.<FLUX_NORMALISE ;
MAIL1 = TAB1.<MAILLAGE ;
* ------------------------

mod1 = modl mail1 mecanique elastique ;
* --- cham du flux normalise
cef0 = chan cham FLUN0 mod1 noeud ;

nel1 = nbel mail1 ;
mess '>@RMFLUN> construction du champ
de flux normalise sur les ' nel1 ' elements';
* initialisation
chamf1 = manu chml mod1 scal 0. stresses type scalaire ;
chamf2 = manu chml mod1 scal 0. stresses type scalaire ;
chamf3 = manu chml mod1 scal 0. stresses type scalaire ;

repe boucel1 nel1 ;
   cef0_1 = extr cef0 scal 1 &boucel1 1 ;
   cef0_2 = extr cef0 scal 1 &boucel1 2 ;
   cef0_3 = extr cef0 scal 1 &boucel1 3 ;

   chamf1 = chamf1 + (manu cham mod1 type scalaire posi
                      stresses scal &boucel1 1 cef0_1);
   chamf2 = chamf2 + (manu cham mod1 type scalaire posi
                      stresses scal &boucel1 1 cef0_2);
   chamf3 = chamf3 + (manu cham mod1 type scalaire posi
                      stresses scal &boucel1 1 cef0_3);
fin boucel1 ;
*
* --- variables de sortie
tab1.<chamf1 = chamf1 ;
tab1.<chamf2 = chamf2 ;
tab1.<chamf3 = chamf3 ;
*
mess '---------------------------------> exiting @RMFLUN';
finproc ;

**** @RMNORM
debproc @RMNORM tab1*table ;

mess '---------------------------------> calling @RMNORM';
*
* --- variables d entree :
*
si (non (existe tab1 <chamx1)) ;
 @rmcoor tab1;
finsi ;

* calcul des normales

* (on pourrait peut etre utiliser VNORM3D. Mais il faut noter
* qu on veut ici les normales au centre des facettes et non aux noeuds.
* On profite du fait qu on a ici que des triangles pour utiliser
* le produit vectoriel de deux cotes du triangle)

abx1 =  (tab1.<chamx2) - (tab1.<chamx1) ;
acx1 =  (tab1.<chamx3) - (tab1.<chamx1) ;

aby1 =  (tab1.<chamy2) - (tab1.<chamy1) ;
acy1 =  (tab1.<chamy3) - (tab1.<chamy1) ;

abz1 =  (tab1.<chamz2) - (tab1.<chamz1) ;
acz1 =  (tab1.<chamz3) - (tab1.<chamz1) ;


nx1 = (aby1*acz1) - (abz1*acy1) ;
ny1 = (abz1*acx1) - (abx1*acz1) ;
nz1 = (abx1*acy1) - (aby1*acx1) ;

* normalisation

nor1 = ((nx1 * nx1) + (ny1 * ny1) + (nz1 * nz1)) ** .5 ;
si (ega (mini nor1) 0.);
 mess '>>>@RMNORM>>> la norme d une des normales est nulle';
 mess '>>>@RMNORM>>> peut-etre maillage n est pas forme de tri3';
 erre '>>>@RMNORM>>> erreur de maillage';
finsi ;
nx2 = nx1 * (nor1 ** -1) ;
ny2 = ny1 * (nor1 ** -1) ;
nz2 = nz1 * (nor1 ** -1) ;

*
* --- variables de sortie
*
tab1.<cosx = nx2 ;
tab1.<cosy = ny2 ;
tab1.<cosz = nz2 ;


mess '---------------------------------> exiting @RMNORM';
finproc ;

**** @RPOI
DEBPROC  @RPOI  LPOINT*MAILLAGE NPOIN*LISTMOTS
                LSHAF1*MAILLAGE CPLASMA*POINT
                >PTG*POINT TAB1*TABLE ;
   LSHAF0 = LSHAF1 ET >PTG ;
   TRAC (LPOINT  ET >PTG ET CPLASMA ET LSHAF0) ;
   XM = COOR 1 LSHAF0 ;
   YM = COOR 2 LSHAF0 ;
   ZM = XM * 0. ;
   XG YG ZG = @CRMGC XM YM ZM TAB1 ;
   RHOP THETAP PHIP = @CRGTC XG YG ZG TAB1.<RP TAB1.<HP;
   GRAY PRAY THERAY = @CSHIFT RHOP THETAP PHIP 1 TAB1;
   LIGRAY0 = CPLASMA D 1 >PTG ;
*   MESS 'POINT : >PTG' ;
   LNOM = MOTS 'PTG' ;
   PRAY0 = EXTR PRAY SCAL >PTG ;
   GRAY0 = EXTR GRAY SCAL >PTG ;
   LPR1 = PROG PRAY0;
   LGR1 = PROG GRAY0 ;
   LINC10 = >PTG ;
   CHPR1 = MANU CHPO  >PTG  1 SCAL  PRAY0 NATURE DISCRET;
   CHGR1 = MANU CHPO  >PTG  1 SCAL  GRAY0 NATURE DISCRET;
   MESS  'POINT >PTG  PRAY0' PRAY0 'GRAY0' GRAY0 ;
   I = 0 ;
   CP1 = CPLASMA ;
   TAN1 =   >PTG;
   POI1 =   >PTG;
   REPETER BOUC21 10;
    POI1 = POI1 TOUR 2. CP1 ;
    TAN1 = TAN1 D 1 POI1;
   FIN BOUC21 ;
   TAN1 = INVE TAN1 ;
   POI1 =  >PTG;
   REPETER BOUC31 10;
    POI1 = POI1 TOUR -2. CP1 ;
    TAN1 = TAN1 D 1 POI1;
   FIN BOUC31 ;
   TAN3 = TAN1 COUL BLEU ;
   TRAC (TAN3 ET (CP1 D 1 >PTG)) ;
   MCO1 = MOTS ROUG ROSE JAUN VERT TURQ BLAN BLEU ;
   REPETER BOUCLE1 (NBNO LPOINT);
      I = I + 1 ;
       POINT0 = LPOINT POIN I ;
       NOMP = NPOIN EXTR I ;
*       MESS 'POINT :' NOMP;
       LNOM = LNOM ET (MOTS NOMP) ;
       GRAY1 = EXTR GRAY SCAL POINT0 ;
       PRAY1 = EXTR PRAY SCAL POINT0 ;
       LPR1 = LPR1 ET (PROG  PRAY1) ;
       LGR1 = LGR1 ET (PROG  GRAY1) ;
      CHPR1 = CHPR1 ET (MANU CHPO POINT0 1 SCAL  PRAY0 NATURE DISCRET);
      CHGR1 = CHGR1 ET (MANU CHPO POINT0 1 SCAL  GRAY0 NATURE DISCRET);

   I1 = I -   (I / 7 * 7) ;
*     ---- centre du cercle dans le repere du maillage
      CP1 = ((COOR 1 CPLASMA) + (GRAY1-GRAY0)) (COOR 2 CPLASMA);
      LIGRAY1 = (CP1 D 1 POINT0) COUL (MCO1 EXTR I1) ;
      LIGRAY0 =  LIGRAY0 ET LIGRAY1     ;
      MESS 'POINT ' NOMP ' PRAY1 ' PRAY1 'GRAY1' GRAY1  ;

*   POINT1 = POINT0;
   TAN1 =  POINT0 ;
   POI1 =  POINT0 ;
   REPETER BOUC2 10;
    POI2 = POI1 TOUR 2. CP1 ;
    TAN1 = TAN1 D 1 POI2;
    POI1 = POI2 ;
   FIN BOUC2 ;
*   POINT1 = POINT0;
   TAN1 = INVE TAN1 ;
   POI1 =  POINT0 ;
   REPETER BOUC3 10;
    POI2 = POI1 TOUR -2. CP1 ;
    TAN1 = TAN1 D 1 POI2;
    POI1 = POI2 ;
   FIN BOUC3 ;
   TAN2 = TAN1 COUL (MCO1 EXTR I1);
   TAN3 = TAN3 ET TAN2;
   TRAC (TAN2 ET (CP1 D 1 POINT0)) ;
   FIN BOUCLE1;
list LNOM ;
list LPR1 ;
list LGR1  ;
*NTAB CHPR1;
*NTAB CHGR1;
FINPROC  TAN3   LIGRAY0                   ;

**** @SCHINTE
DEBPROC @SCHINTE   LSIN2*MAILLAGE LPA21*MAILLAGE
                        EPS3*FLOTTANT PP_1/POINT     ;
MESS '-----------------------------------> entree dans @SCHINTE ';
 SI ( NON (EXISTE PP_1 ))          ;
  P_1 = LSIN2 POIN INITIAL  ;
 SINON                        ;
  P_1 = LSIN2 POIN PROC PP_1         ;
 FINSI                    ;
 I__1 = 0                ;
 REPETER BOUCP 10       ;
   I__1 = I__1 + 1             ;
   EPS2 = EPS3                       ;
   EL_1 = ELEM LSIN2 CONTENANT P_1  ;
   P_11 = POIN 1 EL_1                ;
   P_12 = POIN 2 EL_1                ;
*   trac ( LPA21 ET ( P_11 D P_12 ))  ;
   PL_1 = LPA21 POIN DROIT P_11 P_12  EPS2 ;
   I__2 = 0                ;
   REPETER BOUCI 10            ;
     I__2 = I__2 + 1             ;
     NBP1= NBNO PL_1       ;
     SI (NBP1 >EG 3 )       ;
      EPS2 = EPS2 / 1.7            ;
*       EPS2 = EPS2 / 1.9    ;
       MESS I__1 I__2 ' ** NB PTS , EPS2 : ' NBP1 EPS2  ;
       PL_1 = LPA21 POIN DROIT P_11 P_12  EPS2 ;
     SINON ;
       QUITTER BOUCI  ;
     FINSI  ;
   FIN BOUCI   ;
   NBP1= NBNO PL_1       ;
   PL_1 = PL_1 POIN 1 ;
   P_1OLD = P_1                     ;
   P_1 = LSIN2 POIN PROC PL_1  ;
   SI ( P_1OLD EGA P_1 0.3E-3  )    ;
      MESS '@SCHINTE >>> ON TROUVE LE POINT D INTERSEC. << '   ;
    LIST PL_1                                     ;
       QUITTER BOUCP ;
   FINSI                                           ;
 FIN BOUCP                                          ;
 MESS '@SCHINTE>> ON EST SORTI DE BOUCP '                     ;
* P_12 MOIN P_11 EST LA TANGENTE  ;
 X_11 = COOR 1 P_11   ;
 X_12 = COOR 1 P_12    ;
 SI ( (X_12 - X_11) >EG 0. )  ;
   VEC_1 = P_12 MOIN P_11    ;
 SINON  ;
   VEC_1 = P_11 MOIN P_12   ;
 FINSI     ;
MESS '-----------------------------------> sortie  de  @SCHINTE ';
FINPROC PL_1 VEC_1 ;

DEBPROC  @SHIFT  RHO*CHPOINT THETA*CHPOINT PHI*CHPOINT
                 TAB1*TABLE ;
*
**************************************************************
* Procedure de calcul des grand et petit rayons du "cercle   *
* de Shafranov" en chaque point defini dans le repere centre *
* sur le plasma.           Alain MOAL (juin 1995)            *
**************************************************************
*
OPTI ECHO 0 ;
*
*--------------- VARIABLES D'ENTREE :
RP    =  TAB1.<RP    ;
RHO0  =  TAB1.<RHO0  ;
LAMB  =  TAB1.<LAMB  ;
*------------------------------------
*
*---- on se ramene a la resolution d'une equation du 2nd degre
*---- variables auxiliaires
AUX1 = 1. + LAMB              ;
AUX2 = RHO * (COS THETA) + RP ;
AUX3 = RHO * (SIN THETA)      ;
DELTA = ((AUX2**2) * (AUX1**2)) - ((AUX1 + 1.) * (
        ((AUX2**2) + (AUX3**2)) * AUX1 - (RP**2) -
        ((RHO0**2) * AUX1)))   ;
*
*---- deux cercles possibles
GRANDR1 = ((AUX2 * AUX1) + (DELTA**0.5))/(AUX1 + 1.) ;
GRANDR2 = ((AUX2 * AUX1) - (DELTA**0.5))/(AUX1 + 1.) ;
*
*---- choix du bon cercle
SI ((COS THETA) >EG 0.) ;
  GRANDR = GRANDR2      ;
SINON                   ;
  GRANDR = GRANDR1      ;
FINSI                   ;
*
*---- calcul du petit rayon
PETITR =  ((AUX2 - GRANDR)**2 + (AUX3**2))**0.5 ;
*
*---- calcul de theta dans le repere centre sur le cercle calcule
THETAR = ATG AUX3 (AUX2 - GRANDR) ;
*
FINPROC GRANDR PETITR THETAR;
**** @TABEAU
*********************************************************
******              PROCEDURE @TABEAU                ******
*********************************************************
* CARACTERISTIQUES DE L EAU
*--------------------------------------------------------
DEBPROC  @TABEAU  L_TRAC/LOGIQUE TAB_1*TABLE                    ;
SI ( NON ( EXISTE L_TRAC ))                                    ;
 L_TRAC = FAUX                                                 ;
FINSI                                                          ;
*
*
*---  PARAMETRES
*
*     ORIGINE : Properties of Water and Steam in SI-Units
*               prepared by Ernst Schmidt ( 0-800C / 0-1000 bar)
*               edited by Ulrich Grigull 1979
*
*---  TSAT (C) EN FONCTION DE LA PRESSION (Pa)
*
PPSAT   = PROG  1.E5    3.E5   6.E5    8.E5  10.E5
               15.5E5  19.8E5  24.E5  28.E5  30.E5
               32.E5   34.E5   36.E5  40.E5  60.E5 ;
PTSAT   = PROG  99.6   133.5   158.8  170.4  179.9
               199.8   212.    221.8  230.   233.8
               237.4   240.9   244.1  250.3  275.5  ;
TAB_1 . EPTSAT = EVOL MANU 'PRESSION' PPSAT 'TEMPERATURE' PTSAT  ;
*
*---  LISTE DES TEMPERATURES DE SATURATION (C)
*
PTSAT = PROG  0.    20.   40.   60.   80.
              100.  120.  140.  160.  180.
              200.  220.  240.  260.  280.  300.    ;
*
*---  LISTE DES TEMPERATURES (C)
*
PTEMP = PROG  0.    20.   40.   60.   80.
              100.  120.  140.  160.  180.
              200.  220.  240.  260.  280.  300.    ;
*
*---  RHO DE L'EAU (kg/m3) EN FONCTION DE LA TEMPERATURE
*
PRHOF = PROG  999.8  998.3  992.3  983.2  971.6
              958.1  942.9  925.8  907.3  886.9
              864.7  840.3  813.6  783.9  750.5  712.2   ;
TAB_1 . ETRHOF = EVOL MANU 'TEMPERATURE' PTEMP 'MASSEVOLUM' PRHOF ;
*
*---  RHO DE LA VAPEUR(kg/m3) A TSAT PSAT EN FONCTION DE TSAT
*
PRHOG = PROG  0.005   0.017  0.05   0.13   0.29
              0.60    1.12   1.97   3.26   5.16
              7.86   11.62  16.76  23.73  33.19  46.19 ;
TAB_1 . ETRHOG = EVOL MANU 'TEMPERATURE' PTSAT 'MASSEVOLUM' PRHOG ;
*
*---  ENTHALPIE DE L'EAU (J/kg) EN FONCTION DE LA TEMPERATURE
*
PHF = PROG    0.       83.86E3   167.45E3  251.09E3  334.92E3
            419.06E3  503.72E3   589.1E3   675.5E3   763.1E3
            852.4E3   943.7E3   1037.6E3  1134.9E3   1236.8E3  1345.E3 ;
TAB_1 . ETHF = EVOL MANU 'TEMPERATURE' PTEMP 'ENTHALPIE' PHF ;
TAB_1 . EHFT = EVOL MANU 'ENTHALPIE' PHF 'TEMPERATURE' PTEMP  ;
*
*---  CHALEUR LATENTE DE VAP. DE L'EAU (J/kg) EN FONCTION DE LA TEMP.
*                                                   ;
PHFG = PROG  250.2E4  245.4E4  240.7E4  235.9E4  230.9E4
             225.7E4  220.2E4  214.4E4  208.1E4  201.3E4
             193.9E4  185.6E4  176.5E4  166.1E4  154.4E4  140.6E4;
TAB_1 . ETHFG = EVOL MANU 'TEMPERATURE' PTEMP 'CH_L_VAP' PHFG ;
*
*---  ENTHALPIE DE LA VAPEUR (J/kg) A TSAT PSAT EN FONCTION DE TSAT
*
PHG = PHFG + PHF                                                ;
TAB_1 . ETHG = EVOL MANU 'TEMPERATURE' PTSAT 'ENTH_VAPEUR' PHG ;
*
*---  TENSION SURFACIQUE (kg/m2s2) EN FONCTION DE LA TEMPERATURE
*
PSIGM = PROG  75.64E-3  72.75E-3  69.60E-3  66.24E-3  62.67E-3
              58.91E-3  54.96E-3  50.85E-3  46.58E-3  42.19E-3
              37.69E-3  33.10E-3  28.42E-3  23.67E-3  18.94E-3  14.3E-3;
TAB_1 . ETSIGM = EVOL MANU 'TEMPERATURE' PTEMP 'TENS_SURF' PSIGM ;
*
*     ORIGINE : Heat Transfer Physical Properties
*               from E.R.G. Eckert and R.M. Drake
*               Analysis of Heat Mass Transfer McGraw-Hill New-York 1972
*
*---  LISTE DES TEMPERATURES (C)
*
PTEM1 = PROG  0.    20.   40.   60.   80.
              100.  120.  140.  160.  180.
              200.  220.  240.  260.  280.6  300.    ;
*
*---  PRANDTL DE L'EAU EN FONCTION DE LA TEMPERATURE
*
PPRAF = PROG  13.6   7.02   4.34   3.02   2.22
              1.74   1.446  1.241  1.099  1.004
              0.937  0.891  0.871  0.874  0.910  1.019 ;
TAB_1 . ETPRAF = EVOL MANU 'TEMPERATURE' PTEM1 'PRANDTL' PPRAF ;
*
*---  VISCOSITE DE L'EAU (kg/ms) EN FONCTION DE LA TEMPERATURE
*
PNNU  = PROG 1.8E-3  1.E-3  .65E-3  .47E-3  .35E-3
             .28E-3 .23E-3  .20E-3  .172E-3 .154E-3
            .138E-3 .126E-3 .117E-3 .108E-3 .102E-3 .96E-4 ;
TAB_1 . ETNNU = EVOL MANU 'TEMPERATURE' PTEM1 'VISCOSITE' PNNU ;
*
*---  LAMBDA DE L EAU (W/mK) EN FONCTION DE LA TEMPERATURE
*
PLLA  = PROG .552  .597  .628  .651  .668
             .680  .685  .684  .680  .675
             .665  .652  .635  .611  .580  .540 ;
TAB_1 . ETLLA = EVOL MANU 'TEMPERATURE' PTEM1 'LAMBDA_EAU' PLLA ;
*
*---  Cp DE L EAU (J/kg.C) EN FONCTION DE LA TEMPERATURE
*
PCPF = PROG  4217.8 4181.8 4178.4 4184.3 4196.4
              4216.1 4250   4283   4342   4417
              4505   4610   4756   4949   5208    5728  ;
TAB_1 . ETCPF = EVOL MANU 'TEMPERATURE' PTEM1 'Cp_EAU' PCPF ;
*
*     ORIGINE : Handbook of Heat Transfer ( McGraw-Hill)
*               Rohsenow and Hartnett ( p 7-5 )
*               Diagramme de Moody
*
*---  COEF DE FROTTEMENT EN FONCTION DU NOMBRE DE REYNOLDS
*---  POUR UNE PAROI LISSE
*
PRE  = PROG  4.E3    6.E3   9.E3   2.E4   6.E4
             1.E5    2.E5   1.E6   3.E6   1.E7 ;
PCF  = PROG  0.01    0.009  0.008  0.006  0.005
             0.0045  0.004  0.003  0.0023 0.002 ;
TAB_1.ETF = EVOL MANU 'REYNOLDS' PRE 'COEFFROT' PCF ;
*
SI L_TRAC                                      ;
 DESSIN TAB_1.EPTSAT                          ;
 DESSIN TAB_1.ETRHOF                          ;
 DESSIN TAB_1.ETRHOG                          ;
 DESSIN TAB_1.ETPRAF                          ;
 DESSIN TAB_1.ETNNU                           ;
 DESSIN ( TAB_1.ETHF  ET TAB_1.ETHG )         ;
 DESSIN ( TAB_1.ETHFG  )                      ;
 DESSIN TAB_1.ETLLA                           ;
 DESSIN TAB_1.ETF                             ;
FINSI                                          ;
FINPROC                                       ;
**** @TESTGEO

DEBPROC @TESTGEO  TAB1*TABLE ;

MESS '---------------------------------> calling @TESTGEO';
MESS 'METHODE GEOMETRIQUE' ;
*
*--------------- VARIABLES D'ENTREE :
*

MAIL1   = TAB1.<S_OMBRE ;
OMB0    = TAB1.<S_OMBRANT ;
IMETHOD = TAB1.<METHODE_REMONTEE ;
chsign1 = tab1.<chsign ;

TYPCAL  = TAB1.<TYPE_CALCUL       ;
RP      = TAB1.<RP ;
RHO0    = TAB1.<RHO0 ;
RR      = TAB1.<RR ;
HP      = TAB1.<HP ;
EPS0    = TAB1.<EPS ;
COEFA   = TAB1.<COEFA ;
COEFB   = TAB1.<COEFB ;
COEFC   = TAB1.<COEFC ;
NBOB    = TAB1.<NBOB  ;

PASB2   = TAB1.<PAS_AVEC_TEST ;
DMAX2   = TAB1.<DIST_AVEC_TEST ;
NBPAS2  = TAB1.<NBPAS2        ;

SI (EXIS TAB1 <PAS_SANS_TEST)    ;
 PASB1  = TAB1.<PAS_SANS_TEST    ;
 DMAX1   = TAB1.<DIST_SANS_TEST  ;
 NBPAS1 = TAB1.<NBPAS1           ;
FINSI                            ;

SI ((VALEUR DIME) EGA 2) ;
   IPLAN = TAB1.<PLAN ;
FINSI ;

SI (EXIS TAB1 <SAUV_PTS_OMBRANTS) ;
 REPO   = TAB1.<SAUV_PTS_OMBRANTS  ;
SINON;
 REPO = FAUX;
FINSI ;

*
* ---
*

SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @CLIGB : check the value of TAB1.<TYPE_CALCUL';
FINSI ;

*xm ym zm = coor omb0 ;
*xg yg zg = @crmgc xm ym zm tab1 ;
*rho theta phi = @crgtc xg yg zg rp hp ;
*rhomax = maxi rho ;
*rhomin = mini rho ;
*thetamax = maxi theta ;
*thetamin = mini theta ;
*RM22/12/98 le test d'appartenance au domaine de validite du
* modele de ripple est fait dans ombrage
*
* -------------------------------------------------------------
*
* --- calcul de l'angle d'incidence maximal s'il n'a pas ete
*     defini par l'utilisateur
*
SI (EXIS TAB1 <INCIDENCE_MAXIMALE) ;
  ALPHA = TAB1.<INCIDENCE_MAXIMALE ;
SINON ;
  ALPHA = @INCI TAB1 ;
  TAB1.<INCIDENCE_MAXIMALE = ALPHA ;
FINSI ;
*
* --- calcul du critere d'intersection s'il n'a pas ete
*     defini par l'utilisateur
*
SI (EXIS TAB1 <DELIM) ;
   DELIM = TAB1.<DELIM ;
SINON ;
   DELIM = @CRIT TAB1 ;
FINSI ;
*
* -------------------------------------------------------------
*
*  --- DUPLICATION DU MAILLAGE OMBRE NON DEFORME
SI ((VALEUR DIME) EGA 3) ;
    VNUL = 0. 0. 0. ;
SINON ;
    VNUL = 0. 0. ;
FINSI ;
* --- MAILLAGE DE TRAVAIL => FORM
MAI1TRAV = MAIL1 PLUS VNUL ;

*
* --- PROJECTION DU CHAMP DE SIGNES SUR LE MAILLAGE DE TRAVAIL
* --- BOUCLE SUR CHAQUE POINT DU MAILLAGE DE TRAVAIL

MAIL1PT = CHAN MAI1TRAV POI1 ;
NBM1 = NBNO MAI1TRAV ;
PT1 = ELEM MAIL1PT POINT 1 ;
PP = MAIL1 POIN PROC PT1 ;
VAL1 = EXTR CHSIGN1 SCAL PP ;
MAILP1 = MANU POI1 PT1 ;
CHSIGTRA = MANU CHPO MAILP1 1 SCAL VAL1 'NATURE' DISCRET ;
REPETER BOUPI (NBM1 - 1) ;
      I = &BOUPI + 1 ;
      PTI = ELEM MAIL1PT POINT I ;
      PPI = MAIL1 POIN PROC PTI ;
      VALI = EXTR CHSIGN1 SCAL PPI ;
      MAILPI = MANU POI1 PTI ;
      CHI = MANU CHPO MAILPI 1 SCAL VALI 'NATURE' DISCRET ;
      CHSIGTRA = CHSIGTRA ET CHI ;
FIN BOUPI ;
*BR 01/10/98 TAB1.<CHSIGN = CHSIGN ;
*
* #######################################################
*
*--- INITIALISATION DES PARAMETRES DE LA BOUCLE
*
* #######################################################
*
I1 = 0 ;
chelim = manu chpo MAI1TRAV 1 'SCAL' 0. nature discret ;
CHP1   = MANU CHPO MAI1TRAV 1 'SCAL' 1. NATURE DISCRET ;
CHDIST = MANU CHPO MAI1TRAV 1 'SCAL' 0. NATURE DISCRET ;
MASQ1 = CHELIM ;


* ---- VARIABLE POUR SAVOIR SI ON EFFECTUE LE VISAVIS OU NON
TVISA = VRAI ;

* ---- coordonnees dans le repere du maillage
XM0 = COOR 1 MAI1TRAV ;
YM0 = COOR 2 MAI1TRAV ;
DIM0 = VALEUR DIME ;
SI (DIM0 EGA 2) ;
   ZM0 = XM0 * 0. ;
   DNUL =  XM0 * 0. ;
   PHINUL = DNUL ;
   THENUL = DNUL ;
   VNUL = 0. 0. ;
SINON ;
   ZM0 = COOR 3 MAI1TRAV ;
   VNUL = 0. 0. 0. ;
FINSI ;

*---- Coordonnees dans le repere global du tore
XG_OLD YG_OLD ZG_OLD = @CRMGC XM0 YM0 ZM0 TAB1 ;

*---- CONSTRUCTION D'UN POINT REPONDANT AU CRITERE DE VISAVIS
PVISA = (OMB0 POIN INIT) PLUS VNUL ;

*---- Repere pour le trace
SI (DIM0 EGA 3) ;
   repxyz = @REPERE (prog 0.1 0.1 0.1) VRAI rouge;
FINSI ;

*---- initialisation des distances
LCOURAN1 = 0. ;
LMAX1    = 0. ;


*
* --- Rappel des parametres de la procedure
*
MESS ' ';
MESS '##################################################';
MESS ' ';
MESS '>@TESTGEO> procedure OMBRAGE, Rappel des parametres
de calcul ';
MESS ' ';

SI (IMETHOD EGA 1) ;
   METH = 'methode explicite des tangentes';
FINSI ;
SI (IMETHOD EGA 2) ;
   METH = 'methode moyenne des tangentes aux extremitee';
FINSI ;
SI (IMETHOD EGA 3) ;
   METH = 'methode du point milieu';
FINSI ;
SI (IMETHOD EGA 4) ;
   METH = 'methode de reprojection';
FINSI ;
MESS METH ;
MESS ' ';

SI (EXIS tab1 <PAS_SANS_TEST)  ;
 MESS 'Calcul en deux parties :';
 MESS ' ';
 MESS 'SANS TEST';
 MESS 'Distance remontee    :' DMAX1  ;
 MESS 'Pas pour la remontee :' PASB1  ;
 MESS 'Nombre d iterations  :' NBPAS1 ;
 MESS ' ';
 MESS 'AVEC TEST';
 MESS 'Distance remontee    :' DMAX2 ;
 MESS 'Pas pour la remontee :' PASB2 ;
 MESS 'Nombre d iterations  :' NBPAS2 ;
SINON ;
 MESS 'Calcul avec test systematique :';
 MESS 'Distance remontee   :' DMAX2 ;
 MESS 'Pas   de remontee   :' PASB2 ;
 MESS 'Nombre d iterations :' NBPAS2 ;
FINSI ;
MESS ' ' ;
MESS 'Critere d interception pour VISAVIS    :' DELIM ;
MESS 'Incidence maximale sur OMBRE en degres :' ALPHA ;

SI (EXIS TAB1 <NTRAC) ;
   MESS 'AVEC 'TAB1.<NTRAC' TRACES INTERMEDIAIRES' ;
FINSI ;

SI (EXIS TAB1 <SAUV_PTS_OMBRANTS ) ;
 SI TAB1.<SAUV_PTS_OMBRANTS ;
  MESS 'Sauvegarde des points ombrants';
 SINON ;
  MESS 'pas de sauvegarde des points ombrants';
 FINSI ;
SINON ;
  MESS 'pas de sauvegarde des points ombrants';
FINSI ;

SI ISHIFT ;
 MESS 'Calcul avec shift de Safranov' ;
SINON ;
 MESS 'Calcul sans shift de Safranov';
FINSI ;

SI IRIPPLE ;
 MESS 'Calcul avec ripple du champ toroidal' ;
SINON ;
 MESS 'Calcul sans ripple du champ toroidal' ;
FINSI ;

MESS ' ';
MESS '##################################################';
MESS ' ';

SI (EXIS TAB1 <DIST_SANS_TEST) ;
 PAR2  = FAUX ;
 TVISA = FAUX ;
 MESS 'PREMIERE PARTIE DU CALCUL, SANS VISAVIS';
 NBPAS0 = NBPAS1 + NBPAS2 ;
SINON ;
 NBPAS0 = NBPAS2 ;
FINSI ;

*
*--------------------------------------------------------------
*
* DEBUT DE LA BOUCLE DE REMONTEE ITERATIVE DES LIGNES DE CHAMP
*
*--------------------------------------------------------------
*
MESS ' ';
MESS '##################################################';
MESS ' ';


SI (EXIS TAB1 <DIST_SANS_TEST) ;

* ------------------ Boucle 1 on remonte sans test -------------------
 PASB0 = PASB1 ;
* increment de la distance de connexion (= PAS tant qu'il n'y a pas
* d'intersection)
 chdist9 = manu chpo MAI1TRAV 1 scal pasb0 ;

 MESS 'PREMIERE PARTIE DU CALCUL, SANS TEST D INTERSECTION';
 REPETER BOUCLE1 NBPAS1 ;
  I1 = I1 + 1 ;
  LCOURAN1 = LCOURAN1 + PASB0 ;
  MESS ' ';
  MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;

* ---- Appel de la procedure de calcul des deplacements selon methode choisie
* ---- Methode Explicite
  SI (IMETHOD EGA 1) ;
   DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
  FINSI ;
* ---- Methode Euler-Cauchy
  SI (IMETHOD EGA 2) ;
   DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  FINSI ;
* ---- Methode Point Milieu Modifiee
  SI (IMETHOD EGA 3) ;
   DEPX0 DEPY0 DEPZ0 =@DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  FINSI ;
* ---- Methode de Reprojection
  SI (IMETHOD EGA 4) ;
   DEPX0 DEPY0 DEPZ0 =@DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
  FINSI ;

* ---- On affecte le signe donnant le sens de remontee aux deplacements
  DEPX0 = CHSIGTRA * DEPX0 ;
  DEPY0 = CHSIGTRA * DEPY0 ;
  DEPZ0 = CHSIGTRA * DEPZ0 ;

* ---- Calcul du deplacement projete selon le cas
  SI (DIM0 EGA 2) ;
* ---- Calcul de  TETA et PHI par @CRGTC
   RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;

*  ---- Projection par un double changement de base
   SI (EGA IPLAN 'PHICONS') ;
    DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
    PHINUL = DNUL ;
    DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
   SINON ;
    DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
    THENUL = DNUL ;
    DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
   FINSI ;
  FINSI ;

* ---- Cas 3D : Dprojete = D
  SI (DIM0 EGA 3) ;
   DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0  ;
  FINSI ;

* ---- On calcule les deplacements (projetes si 2D)
* ---- dans le repere du maillage pour le FORM
* ----  avec la procedure de changement de base
  DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;

  DEPX1 = NOMC UX DX NATURE DIFFUS ;
  DEPY1 = NOMC UY DY NATURE DIFFUS ;
  DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;

  DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
  FORM DEP1 ;

* ---- Calcul analytique des nouvelles coordonnees dans le repere global
*    (deplacements non projetes meme en 2D)

  XG_NEW = XG_OLD + DEPX0 ;
  YG_NEW = YG_OLD + DEPY0 ;
  ZG_NEW = ZG_OLD + DEPZ0 ;

  XG_OLD = XG_NEW ;
  YG_OLD = YG_NEW ;
  ZG_OLD = ZG_NEW ;


*---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
  chdist = chdist + CHDIST9 ;




* --- actualisation des champs de coordonnees pour iteration suivante

  XG_OLD = XG_NEW ;
  YG_OLD = YG_NEW ;
  ZG_OLD = ZG_NEW ;

 FIN BOUCLE1 ;
* ------------------------ Fin de la boucle 1 ------------------------
finsi ;



MESS ' ';
MESS '##################################################';
MESS ' ';

MESS 'CALCUL AVEC TEST D INTERSECTION';

* ------------------ Boucle 2 on remonte avec test -------------------
PASB0 = PASB2 ;
REPETER BOUCLE2 NBPAS2 ;

 I1 = I1 + 1 ;
 LCOURAN1 = LCOURAN1 + PASB0 ;
 MESS ' ';
 MESS 'ITERATION : ' I1 'distance remontee' LCOURAN1 ;


*---- Appel de la procedure de calcul des deplacements selon methode choisie
*---- Methode Explicite
 SI (IMETHOD EGA 1) ;
  DEPX0 DEPY0 DEPZ0 = @DEXPLI XG_OLD YG_OLD ZG_OLD PASB0 TAB1;
 FINSI ;
*---- Methode Euler-Cauchy
 SI (IMETHOD EGA 2) ;
  DEPX0 DEPY0 DEPZ0 = @DMOYEN XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
 FINSI ;
*---- Methode Point Milieu Modifiee
 SI (IMETHOD EGA 3) ;
  DEPX0 DEPY0 DEPZ0 = @DMILIEU XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
 FINSI ;
*---- Methode de Reprojection
 SI (IMETHOD EGA 4) ;
  DEPX0 DEPY0 DEPZ0 = @DREPROJ XG_OLD YG_OLD ZG_OLD PASB0 CHSIGTRA TAB1;
 FINSI ;

*---- On affecte le signe donnant le sens de remontee aux deplacements
 DEPX0 = CHSIGTRA * DEPX0 ;
 DEPY0 = CHSIGTRA * DEPY0 ;
 DEPZ0 = CHSIGTRA * DEPZ0 ;

*---- Calcul du deplacement projete selon le cas
 SI (DIM0 EGA 2) ;
*---- Calcul de  TETA et PHI par @CRGTC
  RHO THETA PHI = @CRGTC XG_OLD YG_OLD ZG_OLD RP HP ;

*---- Projection par un double changement de base
  SI (EGA IPLAN 'PHICONS') ;
   DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
   PHINUL = DNUL ;
   DEPXP DEPYP DEPZP = @CBTGV DRO DTETA DNUL THETA PHINUL;
  SINON ;
   DRO DTETA DPHI = @CBGTV DEPX0 DEPY0 DEPZ0 THETA PHI ;
   THENUL = DNUL ;
   DEPXP DEPYP DEPZP = @CBTGV DRO DNUL DPHI THENUL PHI ;
  FINSI ;
 FINSI ;

*---- Cas 3D : Dprojete = D
 SI (DIM0 EGA 3) ;
  DEPXP DEPYP DEPZP = DEPX0 DEPY0 DEPZ0  ;
 FINSI ;

* ---- On calcule les deplacements (projetes si 2D)
* ---- dans le repere du maillage pour le FORM
* ----  avec la procedure de changement de base
 DX DY DZ = @CBGMV DEPXP DEPYP DEPZP TAB1 ;

 DEPX1 = NOMC UX DX NATURE DIFFUS ;
 DEPY1 = NOMC UY DY NATURE DIFFUS ;
 DEPZ1 = NOMC UZ DZ NATURE DIFFUS ;

 DEP1 = DEPX1 ET DEPY1 ET DEPZ1 ;
 FORM DEP1 ;

*---- Calcul analytique des nouvelles coordonnees dans le repere global
*    (deplacements non projetes meme en 2D)

 XG_NEW = XG_OLD + DEPX0 ;
 YG_NEW = YG_OLD + DEPY0 ;
 ZG_NEW = ZG_OLD + DEPZ0 ;

 XG_OLD = XG_NEW ;
 YG_OLD = YG_NEW ;
 ZG_OLD = ZG_NEW ;

*---- test sur les eventuels noeuds interceptes
*---- SEULEMENT SI NECESSAIRE (D'APRES DEMANDE UTILISATEUR)
 ptest pt2 = visavis (MAI1TRAV et pvisa) omb0 delim;
 si ((nbno ptest) > 1) ;
  pt1 pt2 = visavis MAI1TRAV omb0 delim;
  MESS 'nombre de noeuds interceptes ='(nbno pt1);
  LMAX1 = LCOURAN1 ;
*
*--- SAUVEGARDE DES POINTS OMBRANTS CONDITIONEL CAR PREND DU TEMPS CPU
  SI REPO ;
   SI (EGA (TYPE POMB) MAILLAGE);
    POMB = POMB ET PT2 ;
   SINON ;
    POMB = PT2 ;
   FINSI ;
  FINSI ;
*
*---- construction du champ contenant 1 aux noeuds
*---- interceptes a l'iteration courante
  chelim1 = manu chpo pt1 1 'SCAL' 1. nature discret ;

*---- construction du champ contenant n aux noeuds
*---- interceptes n fois
  chelim = chelim et chelim1 ;

*---- CHPOINT CONTENANT DES 1 POUR LES NOEUDS
*---- INTERCEPTES AU MOINS UNE FOIS
  masq1 = chelim masq 'SUPERIEUR' 0. ;

* ---- nombre de points interceptes depuis le debut
* ---- du calcul :
  PTPRIS = masq1 poin superieur 0.;

* ---- on quitte la boucle si tous les noeuds ont
* ---- ete interceptes
  SI ((NBNO PTPRIS) EGA (NBNO MAI1TRAV)) ;
   QUITER BOUCLE1 ;
  FINSI ;
 FINSI ;
*---- fin du test d'interception

*---  CHPOINT CONTENANT LES DISTANCES PARCOURUES AVANT INTERCEPTION
 chdisti = PASB0 * (CHP1 - MASQ1) ;
 chdisti = chan attribut chdisti nature discret ;
 chdist = chan attribut chdist nature discret ;
 chdist = chdist et chdisti ;
 mess 'mini maxi dist connection en m'
 (mini (prog lmax1(mini chdist))) lmax1 ;

* mess 'mini maxi dist connection en m'
* (mini chdist) (maxi chdist);


*--- Traces intermediaires si TAB1.<NTRAC specifie
 SI (EXIS TAB1 <NTRAC) ;
  NSORT = NBPAS0 / TAB1.<NTRAC ;
  SI (NSORT EGA 0) ;
   NSORT = 1 ;
  FINSI ;
  OUT = (I1 - (NSORT*(I1/NSORT)));
  SI ( OUT EGA 0);
*---- CAS 3D
   SI (DIM0 EGA 3) ;
    SI TVISA ;
     SI ((nbno ptest) > 1) ;
      titre 'pas='i1'  on trouve'(nbno (pt1))
      'noeuds verifiant le critere';
      trac (0. 1.E+6 0.) ((PT1 COUL ROUG) ET MAI1TRAV
      ET MAIL1 et repxyz ET OMB0 );
      trac (1.E+6 0. 0.)  ((PT1 COUL ROUG) ET MAI1TRAV
      ET MAIL1 et repxyz ET OMB0 );
      trac (0. 0. 1.E+6)  ((PT1 COUL ROUG) ET MAI1TRAV
      ET MAIL1 et repxyz ET OMB0 );
     SINON ;
      titre 'pas='i1'  pas de noeud verifiant le critere';
      trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG)
      ET MAIL1 et repxyz ET OMB0 );
      trac (1.E+6 0. 0.)  ((MAI1TRAV COUL ROUG)
      ET MAIL1 et repxyz ET OMB0 );
      trac (0. 0. 1.E+6)  ((MAI1TRAV COUL ROUG)
      ET MAIL1 et repxyz ET OMB0 );
     FINSI ;
    SINON ;
     titre 'pas='i1'  pas de test effectue';
     trac (0. 1.E+6 0.) ((MAI1TRAV COUL ROUG)
     ET MAIL1 et repxyz ET OMB0 );
     trac (1.E+6 0. 0.)  ((MAI1TRAV COUL ROUG)
     ET MAIL1 et repxyz ET OMB0 );
     trac (0. 0. 1.E+6)  ((MAI1TRAV COUL ROUG)
     ET MAIL1 et repxyz ET OMB0 );
    FINSI ;
*---- CAS 2D ==> TRACE DANS LE PLAN
   SINON ;
    SI ((nbno ptest) > 1) ;
     titre 'pas='i1'  on trouve'(nbno (pt1))
     'noeuds verifiant le critere';
     trac (MAI1TRAV ET (PT1 COUL ROUG) ET MAIL1 ET OMB0 );
    SINON ;
     titre 'pas='i1'  pas de noeud verifiant le critere';
     trac (MAIL1 ET MAI1TRAV ET OMB0 );
    FINSI ;
   FINSI ;
  FINSI;
 FINSI;
 MENAGE ;
FIN BOUCLE2 ;
* --------------------- Fin de la boucle 2 ----------------------

*---- PASSAGE DU SUPPORT MAILLAGE DEFORME
*---- AU SUPPORT MAILLAGE INITIAL POUR CHDIST

* CREATION DE LA LISTE DES DISTANCES CONTENUES DANS CHDIST
*
NDIST = NBNO MAI1TRAV ;
I = 1 ;
MAI1TRAV = CHAN MAI1TRAV POI1 ;
PT1 = ELEM MAI1TRAV POIN 1 ;
DIST1 = EXTR CHDIST SCAL PT1 ;
LDIST = PROG DIST1 ;
REPETER BOULISTE (NDIST - 1) ;
 I = I + 1 ;
 PTI = ELEM MAI1TRAV POIN I ;
 DISTI = EXTR CHDIST SCAL PTI ;
 LDIST = LDIST ET (PROG DISTI) ;
FIN BOULISTE ;

* CONSTRUCTION DU CHAMP DES DISTANCES SUR LE MAILLAGE NON DEFORME *
CHDIST0 = MANU CHPO MAIL1 1 SCAL LDIST ;

*--- Sorties dans TAB1
TAB1.<DELIM = DELIM ;
TAB1.<CONNEXION_MAX = LMAX1 ;
TAB1.<LONGUEUR_REMONTEE = LCOURAN1 ;
MESS '---------------------------------> exiting @TESTGEO';
FINPROC CHDIST0 MAI1TRAV POMB ;

**** @THERSC0
'DEBPROC' @THERSC0 TAB1*'TABLE   '   ;
MESS ' ' ;
NIVEAU = TAB1.'NIVEAU' ;
SI ((EXISTE TAB1 'VITESSE')
 OU (EXISTE TAB1 'PRESS_IN')
 OU (EXISTE TAB1 'TEMPE_IN'));
 MESS '   ' ;
 MESS '   ' ;
 MESS '   ' ;
 MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  ' ;
 MESS '   ' ;
 MESS '>@THERSC0> RM le 26/10/95  ' ;
 MESS '>@THERSC0> attention plusieurs donnees doivent etre stockees';
 MESS '>@THERSC0> sous des noms d indices differents  ' ;
 MESS '>@THERSC0> VITESSE  remplace par  V_IN  ' ;
 MESS '>@THERSC0> TEMPE_IN remplace par  T_IN ' ;
 MESS '>@THERSC0> PRESS_IN remplace par  P_IN  ' ;
 MESS '   ' ;
 MESS '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  ' ;
 MESS '   ' ;
 MESS '   ' ;
 MESS '   ' ;
 MESS '   ' ;
FINSI;

SI (NIVEAU >EG 4 ) ;
 MESS '---------------------------------> calling @THERSC0';
 MESS '>@THERSC0>    Talking Level' NIVEAU ;
FINSI ;
*
* --- procedure d'initialisation thermique standard groupe CFP
*
 TAC8 = TABLE                           ;
 TAC8.1 = 'MARQ CROI REGU'         ;
 TAC8.2 = 'MARQ PLUS REGU'         ;
 TAC8.3 = 'MARQ ETOI REGU'         ;
 TAC8.4 = 'MARQ LOSA REGU'         ;
 TAC8.5 = 'MARQ CARR REGU'                     ;
 TAC8.6 = 'MARQ TRIA REGU'                     ;
 TAC8.7 = 'MARQ TRIB REGU'                     ;
 TAC8.8 = 'MARQ PLUS REGU'         ;
 TAC8.9 = 'MARQ ETOI REGU'         ;
 TAC8.10 = 'MARQ CROI REGU'         ;
 TAC8.11 = 'MARQ LOSA REGU'         ;
 TAC8.12 = 'MARQ CARR REGU'                     ;
 TAC8.13 = 'MARQ TRIA REGU'                     ;
 TAC8.14 = 'MARQ TRIB REGU'                     ;
 TAC8.15 = 'MARQ ETOI REGU'         ;
 TAC8.16 = 'MARQ CROI REGU'         ;
 TAC8.17 = 'MARQ PLUS REGU'         ;
 TAC8.18 = 'MARQ CARR REGU'         ;
 TAC8.19 = 'MARQ CARR REGU'                     ;
 TAC8.20 = 'MARQ TRIA REGU'                     ;
 TAC8.21 = 'MARQ TRIB REGU'                     ;
 TAC8.22 = 'MARQ CROI REGU'         ;
 TAC8.23 = 'MARQ PLUS REGU'         ;
 TAC8.24 = 'MARQ ETOI REGU'         ;
 TAC8.25 = 'MARQ CROI REGU'         ;
 TAC8.26 = 'MARQ PLUS REGU'                     ;
 TAC8.27 = 'MARQ ETOI REGU'                     ;
 TAC8.28 = 'MARQ CROI REGU'                     ;
*
 SI ( EGA ( VALE DIME) 2 )                              ;
    TAB1.VIEW_P = TEXT '    '                              ;
 FINSI                                                  ;
 SI ( NON (EXISTE TAB1 VIEW_P ))                          ;
   SI ( EGA ( VALE DIME) 3 )                              ;
    TAB1.VIEW_P = 1.E8 -1.E8 1.E8                         ;
   FINSI                                                  ;
 FINSI                                         ;
*
* list V_DIM1 ;
* list  TAB1.LFLUX_EXTE;
 V_DIM1 = VALEUR 'DIME' ;
 SI ( V_DIM1 EGA 2)  ;
    TFRONT1 = TEXT ' CONTOUR ' ;
    TAB1 . MO_CONTOUR = TEXT ' CONTOUR ' ;
    SI ( NON ( EXISTE TAB1 LFLUX_EXTE_DESS));
     TAB1.LFLUX_EXTE_DESS =  TAB1.LFLUX_EXTE ;
    FINSI                                    ;
    SI ( NON ( EXISTE TAB1 LFLUX_CONV_DESS));
     TAB1.LFLUX_CONV_DESS =  TAB1.LFLUX_CONV ;
    FINSI                                    ;
    SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
     TAB1.LFLUX_RAYO_DESS  =  TAB1.LFLUX_RAYO ;
    FINSI                                   ;
 SINON ;
  TFRONT1 = TEXT ' ENVELOP ' ;
  TAB1 . MO_CONTOUR = TEXT ' ENVELOP ' ;
 FINSI ;

SI ( NON ( EXISTE TAB1 TITR_MAQ ))                 ;
 TAB1.TITR_MAQ = ' '     ;
 SI (NIVEAU >EG 2) ;
  MESS
'>@THERSC0> TAB1.TITR_MAQ       set to default value : nothing  '  ;
 FINSI ;
FINSI                                                ;

SI ( NON ( EXISTE TAB1 T_TAPE  ))                 ;
 TAB1.T_TAPE = 0.     ;
 SI (NIVEAU >EG 2) ;
  MESS '>@THERSC0> TAB1.T_TAPE         set to default value : 0  '  ;
 FINSI ;
FINSI                                                ;

SI ( NON ( EXISTE TAB1 TWIST_RATIO ))                 ;
 TAB1.TWIST_RATIO = 0.     ;
 SI (NIVEAU >EG 2) ;
  MESS '>@THERSC0> TAB1.TWIST_RATIO    set to default value : 0';
 FINSI ;
FINSI                                                ;

SI ( NON ( EXISTE TAB1 L_TRAC_FLUXI ))                 ;
 TAB1.L_TRAC_FLUXI = FAUX     ;
 SI (NIVEAU >EG 2) ;
  MESS '>@THERSC0> TAB1.L_TRAC_FLUXI   set to default value : FAUX' ;
 FINSI ;
FINSI                                                ;

SI (NON (EXISTE TAB1 CHFCORRELATION));
 TAB1.CHFCORRELATION = MOTS 'TONG';
 SI (NIVEAU >EG 2) ;
  MESS '>@THERSC0> TAB1.CHFCORRELATION set to default value : TONG' ;
 FINSI ;
FINSI ;

SI (NON (EXISTE TAB1 X_LOCAL));
 TAB1.'X_LOCAL' = 1. ;
 SI (NIVEAU >EG 2) ;
  MESS '>@THERSC0> TAB1.X_LOCAL set to default value :  1.(=exit)' ;
 FINSI ;
FINSI ;


*
*--- CARACT . DE L'ECOULEMENT
*
PI  = 3.14159                               ;
*
VIN     =  TAB1 . V_IN                   ;
TAB1.V_LOCAL = VIN                             ;
MESS '>@THERSC0> V_LOCAL set to VIN (provisional) ';
TIN     =  TAB1 . T_IN                   ;
LMAQ    =  TAB1 . L_MAQUETTE                   ;
DIAM1   =  TAB1 . D_MAQUETTE                  ;
PIN     =  TAB1 . P_IN                  ;
TTAPE   =  TAB1 . T_TAPE                ;
YTWIST  =  TAB1 . TWIST_RATIO               ;
LAMBDA  =  TAB1 . 'LAMBDA'               ;
LPAT1   =  TAB1 . LFLUX_EXTE   ;
*
*--- CALCUL CHUTE DE PRESSION
*
*js tous ces XLPAT1 XL_LPAT1 TAB1 . W_HEATED n'ont rien a faire ici
*js  c est le pb CFLUX
 XLPAT1 = COOR 1 LPAT1                               ;
 XL_LPAT1 = ABS (( MAXI XLPAT1 ) - ( MINI  XLPAT1 ));

 MESS '>@THERSC0> width of the mesh line used for flux deposition'
                                     XL_LPAT1        ;

 SI ( NON ( EXISTE TAB1 W_HEATED ))                 ;
  TAB1 . W_HEATED = XL_LPAT1 * (TAB1 . FSYM_X )     ;
  MESS '>@THERSC0> Heated width (with symetrical part)'
                                            (TAB1.W_HEATED);
 SINON                                                ;
  XL_HEATE = ((TAB1 . W_HEATED ) / (TAB1 . FSYM_X ))  ;
  MESS '>@THERSC0> control of the heated width  '             ;
  MESS '>@THERSC0> heated width / FSYM_X ' XL_HEATE         ;
 FINSI                                                ;

 SI (NIVEAU >EG 3 ) ;
  MESS '>@THERSC0> prompting of various data before PDROP';
  MESS DIAM1 VIN TIN LMAQ (TAB1.L_HEATED) (TAB1.W_HEATED)
                            LAMBDA PIN TTAPE YTWIST  ;
 FINSI ;

SI ( NON ( EXISTE TAB1 HYPERVAP ) )                             ;
 TAB1.HYPERVAP = FAUX                                           ;
FINSI                                                           ;
*js TAB1.P_LOCAL doit etre calculer par @PDROP
 SI ( EGA TAB1.HYPERVAP VRAI )    ;
  TAB1 . P_LOCAL = PIN           ;
 SINON                             ;
  SI (NON (EXISTE TAB1 P_LOCAL))                                  ;
   DPRES PIN_LH POU_H POUT = @PDROP TAB1                          ;
   TAB1.P_LOCAL =  PIN_LH +  ((POU_H - PIN_LH) * TAB1.'X_LOCAL')  ;
  FINSI                                                           ;
 FINSI ;
*
*
*js CPF = @IPOE TIN TAB1.ETCPF                                       ;
*js
*js RHOIN   = @IPOE TIN TAB1.ETRHOF                                    ;
*
*js NNUIN = @IPOE TIN  TAB1.ETNNU                                      ;
*js GIN  = RHOIN * VIN                                                ;
*js SI ( EXISTE TAB1  RIP_FLOWS )                                     ;
*js  EMDOTI = GIN * ( TAB1 . RIP_FLOWS )                              ;
*js SINON                                                             ;
*js  SI ( EGA TAB1.HYPERVAP VRAI )    ;
*js   TAB1.HYP_SM = ( TAB1.LARG_CANAL * TAB1.HMIN_CANAL ) +
*js                  ( 2. * ( TAB1.LARG_ESP * TAB1.HFIN ) )     ;
*js   EMDOTI = GIN *  TAB1.HYP_SM  ;
*js  SINON   ;
*js   EMDOTI = GIN * ( ( PI * DIAM1 * DIAM1 / 4. ) - ( DIAM1 * TTAPE) ) ;
*js  FINSI                                                             ;
*js FINSI ;
* Parametre servant au calcul de Tout grace au flux,
* au Cp et a Tin
*js TAB1.V_EMDOTI = EMDOTI           ;

*
*--- DONNEES POUR 'H' DANS LA BOUCLE
*
SI (NIVEAU >EG 2 ) ;
 MESS '>@THERSC0> >>>>> 1   >>>>>>'               ;
FINSI ;
SI  ( NON ( EXISTE TAB1  TRANSITOIRE ))   ;
 TAB1.TRANSITOIRE = FAUX              ;
FINSI                              ;
SI  ( NON ( EXISTE TAB1  PERMANENT ))   ;
  TAB1.PERMANENT = FAUX              ;
FINSI                              ;
SI  ( NON ( EXISTE TAB1  MAX_SOFL ))   ;
  TAB1.MAX_SOFL  = 50.E6              ;
FINSI                              ;
SI  ( NON ( EXISTE TAB1  OLD ))   ;
  TAB1.OLD = VRAI              ;
FINSI                              ;
SI TAB1.OLD                        ;
 EVMA1 EVCA1 TACC1 = @DEMATH1 TAB1                    ;
SINON                                                ;
 EVMA1 EVCA1 TACC1 = @DEMATH2 TAB1                    ;
FINSI                                                ;
*js3.95 ici il faudrait faire une proc de controle du maillage @CTMAIL
SI (NIVEAU >EG 2 ) ;
 MESS '>@THERSC0> >>>>> 2.1>>>>>>> '               ;
FINSI ;

  IPP1 = 0                                ;
  REPETER BOUCMA8                              ;
    IPP1 = IPP1 + 1                                   ;
    SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                         ;
     SI ( IPP1 EGA 1 )                                         ;
      S_TOT1 = TAB1.ZONE_MAT . IPP1                             ;
      C_ONT1 = TFRONT1 (TAB1.ZONE_MAT . IPP1 )                 ;
     SINON                                                     ;
      S_TOT1 = S_TOT1 ET (TAB1.ZONE_MAT . IPP1)                  ;
      C_ONT1 = C_ONT1 ET ( TFRONT1 (TAB1.ZONE_MAT. IPP1))      ;
     FINSI                                                     ;
    SINON                                                      ;
     QUITTER BOUCMA8                                           ;
    FINSI                                                      ;
  FIN BOUCMA8                                                   ;
  TAB1.'M_ILLAGE_TOT' = S_TOT1 ;
  TAB1.'<MAILLAGE' = S_TOT1 ;

  TRAC TAB1.VIEW_P S_TOT1 ;
  TAB1.'M_IL_CONTOUR'    = C_ONT1                            ;
  IPP1 = 0                                ;

  SI ( EXISTE TAB1 V_SOURCE )                         ;
   MESS '>@THERSC0> There is a volumetric heat source';
   MO_TOT = MODL S_TOT1 'THERMIQUE' 'ISOTROPE'        ;
   FSOU1 = SOURCE MO_TOT 0. S_TOT1                   ;
  FINSI                                                      ;
  REPETER BOUCMA9                              ;
    IPP1 = IPP1 + 1                                   ;
    SI ( EXISTE (TAB1.ZONE_MAT) IPP1 )                         ;
     SI ( EXISTE TAB1 V_SOURCE )                                ;
*jfs,le 18/07/95: ajout de la possibilite d'utiliser des sources
*                 variables dans les materiaux (chpoints)
      SI ( EXISTE (TAB1.V_SOURCE) CHSO )                        ;
       SI ( EXISTE (TAB1.V_SOURCE.CHSO) IPP1 )                ;
        MO_1  = TAB1.DEF_MO.IPP1                                ;
        FSOU1 = FSOU1 ET
        ( SOURCE MO_1 TAB1.V_SOURCE.CHSO.IPP1  )   ;
        MESS '>THERSCH0> SOURCE MATERIAL CHPOINT ' IPP1          ;
       FINSI                                                     ;
      SINON                                                     ;
       SI ( EXISTE (TAB1.V_SOURCE) IPP1 )                        ;
*       MO_1  = MODL TAB1.ZONE_MAT.IPP1 'THERMIQUE' 'ISOTROPE'   ;
        MO_1  = TAB1.DEF_MO.IPP1                                ;
        FSOU1 = FSOU1 ET
        ( SOURCE MO_1 TAB1.V_SOURCE.IPP1 TAB1.ZONE_MAT.IPP1 )   ;
        MESS '>@THERSC0> SOURCE MATERIAL ' IPP1                  ;
       FINSI                                                     ;
      FINSI                                                     ;
     FINSI                                                      ;
    SINON                                                      ;
     QUITTER BOUCMA9                                           ;
    FINSI                                                      ;
  FIN BOUCMA9                                                   ;
TAB1.'FSOU1' = FSOU1 ;
*
SI (NIVEAU >EG 2 ) ;
 MESS '>@THERSC0> >>>>> 2.2 >>>>>>'               ;
FINSI ;
 TRAC TAB1.VIEW_P CACH TAB1.'M_IL_CONTOUR'     ;
 SI ( EXISTE TAB1 VIEW_P2 )                          ;
      TRAC  CACH TAB1.VIEW_P2 C_ONT1                             ;
 FINSI                                                      ;
* TEX1 = TEXTE TAB1.NOM_MAT.1 '_MAT_1_CONDUCTIVITY'       ;
 SI ( NON ( EXISTE TAB1 V_XBORMA));
  TAB1.V_XBORMA = 1500.           ;
 FINSI                            ;
 TAC1 = TABLE                           ;
* TAC1.1 = TEXTE 'MARQ TRIA TITRE ' TEX1         ;
 DESSIN EVMA1 XBOR 0. TAB1.V_XBORMA YBOR 0. 500. MIMA LEGE TACC1;
SI ( TAB1.TRANSITOIRE )                            ;
 TAC1 = TABLE                           ;
 SI (EXISTE (TAB1.ZONE_MAT) 1);
  TAC1.1 = ET 'MARQ TRIA REGU TITRE ' TAB1.NOM_MAT.1;
 FINSI;
 SI (EXISTE (TAB1.ZONE_MAT) 2);
  TAC1.2 = ET 'MARQ TRIB TITRE ' TAB1.NOM_MAT.2;
 FINSI;
 SI (EXISTE (TAB1.ZONE_MAT) 3);
  TAC1.3 = ET 'MARQ ETOI TITRE 'TAB1.NOM_MAT.3;
 FINSI;
 SI (EXISTE (TAB1.ZONE_MAT) 4);
  TAC1.4 = ET 'MARQ LOSA TITRE 'TAB1.NOM_MAT.4;
 FINSI;
 DESSIN  EVCA1   XBOR 0. TAB1.V_XBORMA MIMA  LEGE TAC1  ;
FINSI                                                ;
*js3.95 ici proc pour calcul des cos directeurs
*** modele necessaire pour le calcul des cosinus directeurs
*
MOP_TOT = MODL S_TOT1 'MECANIQUE' 'ELASTIQUE'  ;
*
*
*---  PERPENDICULAIRE A LA LIGNE DE RAYONNEMENT
*
 SI ( NON ( EXISTE TAB1 LFLUX_RAYO_DESS));
     TAB1.LFLUX_RAYO_DESS  =  TAB1.LFLUX_RAYO ;
 FINSI                                   ;
*> SI ( NON ( EXISTE  TAB1 LFLUX_RAY2 ))     ;
*>   TAB1.LFLUX_RAY2 =  TAB1.LFLUX_RAYO     ;
*>   TAB1.LFLUX_RAY2_DESS =  TAB1.LFLUX_RAYO_DESS     ;
*> FINSI                                    ;
** LRAYON1 =  TAB1.LFLUX_RAYO               ;

 COTETR1 SITETR1 C3TETR1 = @VNORM3D
  (EXTR TAB1.'MODELR' 'MAIL' ) TAB1.LFLUX_RAYO NIVEAU;
*
*---  PERPENDICULAIRE A LA LIGNE DE CONVECTION
*
* LINT1 =  TAB1.LFLUX_CONV               ;
 S_CONV = EXTR TAB1.'MODELV' 'MAIL'  ;
 C_CONV = TAB1.MO_CONTOUR S_CONV      ;
 N_E1 = NBNO C_CONV                       ;
 N_E2 = NBNO (C_CONV  ET TAB1.LFLUX_CONV)          ;
 SI ( N_E1 NEG N_E2 ) ;
  ERRE '@THERSC0  >>>NBNO DIFFERENTS POUR LFLUX_CONV et MODELV '  ;
 FINSI                                                   ;
*SI (EXISTE TAB1 STUB1 )                                ;
* COTETC1 SITETC1 C3TETC1 = @VNORM3D
*                       TAB1.STUB1 TAB1.LFLUX_CONV NIVEAU;
*SINON                          ;
COTETC1 SITETC1 C3TETC1 = @VNORM3D S_CONV (TAB1.LFLUX_CONV) NIVEAU;
*FINSI                                                   ;
MESS '@THERSC0 >>>>> 2.3 >>>>>>'               ;
*
*---  PERPENDICULAIRE A LA LIGNE DE FLUX INCIDENT
*
SI ( EXISTE TAB1 'LAMDAQ2'  )              ;
 COTETF1 SITETF1 C3TETF1 = @VNORM3D ( EXTR TAB1.'MODELF' 'MAIL')
                       (TAB1.LFLUX_EXTE ET TAB1.LFLUX_EXT2) NIVEAU;
SINON;
 COTETF1 SITETF1 C3TETF1 = @VNORM3D
             (EXTR TAB1.'MODELF' 'MAIL') ( TAB1.LFLUX_EXTE) NIVEAU;
FINSI ;
 TAB1.C_COTETF1 =  COTETF1                                    ;
 TAB1.C_SITETF1 =  SITETF1                                    ;
*---- A.MOAL : on a besoin du 3eme cos directeur pour la visu 3D
 TAB1.C_COS3F1  =  C3TETF1                                    ;
 TAB1.C_C3TETF1  =  C3TETF1                                    ;
*----
 TAB1.C_COTETR1 =  COTETR1                                    ;
 TAB1.C_SITETR1 =  SITETR1                                    ;
 TAB1.C_C3TETR1 =  C3TETR1                                    ;
 TAB1.C_COTETC1 =  COTETC1                                    ;
 TAB1.C_SITETC1 =  SITETC1                                    ;
 TAB1.C_C3TETC1 =  C3TETC1                                    ;


**>> TETF1   =  ATG  SITETF1 ( COTETF1 + 1.E-12) ;
*mess 'cotetft et sitetf1 ' ; list COTETF1 ; list SITETF1;

*js 3 11 94
*TAB1.LIS_TEMP  = TABLE                                ;
*  IPP1 = 0;
*  REPETER BOUPO2 (DIME TAB1.LI_POINT);
*    IPP1 = IPP1 + 1;
*    TAB1.LIS_TEMP . IPP1 = PROG;
*  FIN BOUPO2;
*
* ca ce devrait etre ds le controle du maillage
NB_1 = NBNO   TAB1.'M_IL_CONTOUR'                          ;
NB_2 = NBNO ( TAB1.LFLUX_EXTE ET TAB1.'M_IL_CONTOUR' )     ;
SI (  NB_1 NEG  NB_2 )                                      ;
 MESS ' IL Y A UN PB ENTRE LA LIGNE DE FLUXI ET LE CONTOUR' ;
 TRACER 'CACH'  TAB1.VIEW_P  ( TAB1.LFLUX_EXTE ET C_ONT1 )  ;
 ERRE ' REVOIR VOTRE LFLUX_EXTE '                           ;
FINSI                                                       ;
*
TAB1.CHPOTHETA  = TABLE                  ;
TAB1.CHPOHCONV  = TABLE                  ;
SI (NIVEAU >EG 2 ) ;
 MESS '---------------------------------> exiting @THERSC0';
FINSI ;

FINPROC                              ;

*--------------------------------------------------------------------
*
*----------Fin de la procedure @THERSC0
**** @THERSC1
'DEBPROC' @THERSC1 TAB1*'TABLE   '                          ;

SI (NON (EXISTE TAB1 NIVEAU));
 TAB1.'NIVEAU' = 1 ;
FINSI ;
SI (TAB1.'NIVEAU' >EG 4) ;
 MESS '---------------------------------> calling @THERSC1';
FINSI ;

*
*---  PARAMETRES
*
@TABEAU TAB1   ;
@THERSC0 TAB1 ;
@FLUXX TAB1   ;
MENAGE        ;
@TPERM TAB1   ;
@TTRANS TAB1  ;
*TAB1.I_FPAT1 = FPAT1;
TAB1.T_TAC8    = TABLE TAC8;
SI (TAB1.PERMANENT EGA VRAI);
FINSI;

SI (TAB1.'NIVEAU' >EG 4 );
 MESS '---------------------------------> exiting @THERSC1';
FINSI ;

FINPROC;
*--------------------------------------------------------------------
*
*----------Fin de la procedure @THERSC1
*
**** @TOKAFLU
DEBPROC  @TOKAFLU TAB1*TABLE ;
*
*123456789012345678901234567890123456789012345678901234567890123456789012
**************************************************************
* Procedure de calcul du profil du depot de puissance sur un *
* objet en tenant compte du ripple et du shift de Shafranov. *
*          Alain MOAL (aout 1995-janvier 1996)               *
**************************************************************
*
MESS '---------------------------------> calling @TOKAFLU';
*
*---- Valeurs par defaut, verification des indices de la table
@VDEFAUT TAB1 ;
*
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<MAILLAGE            ;
CONT0    = TAB1.LFLUX_EXTE           ;
LAMBQREF = TAB1.<LAMBQREF            ;
THETA0   = TAB1.<THETA0              ;
RHO0     = TAB1.<RHO0                ;
RP       = TAB1.<RP                  ;
IMESS    = TAB1.<IMESS               ;
MMAIL0   = TAB1.MODELF               ;
TYPCAL   = TAB1.<TYPE_CALCUL         ;
TYPDEP   = MOT TAB1.<TYPE_DEPOT      ;
ITRAC    = TAB1.<ITRAC               ;
SI (NON (EXISTE TAB1 <NXM))          ;
   ICALNORM = VRAI                   ;
SINON                                ;
   ICALNORM = FAUX                   ;
   NXM = TAB1.<NXM                   ;
   NYM = TAB1.<NYM                   ;
   NZM = TAB1.<NZM                   ;
FINSI                                ;
SI ((VALEUR DIME) EGA 3)             ;
   OEIL0 = TAB1.VIEW_P               ;
SINON                                ;
   CONTDES0 = TAB1.LFLUX_EXTE_DESS   ;
FINSI                                ;
*------------------------------------
*
SI (EGA TYPCAL 'AVEC_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'AVEC_SHIFT_SANS_RIPPLE') ;
   ISHIFT = VRAI ;
   IRIPPLE = FAUX ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_AVEC_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = VRAI ;
FINSI ;
SI (EGA TYPCAL 'SANS_SHIFT_SANS_RIPPLE') ;
   ISHIFT = FAUX ;
   IRIPPLE = FAUX ;
FINSI ;
SI ((NON (EXISTE ISHIFT)) OU (NON (EXISTE IRIPPLE))) ;
   ERRE ' >>>> @TOKAFLU : check the value of TAB1.<TYPE_CALCUL';
FINSI ;
SI (EGA TYPDEP 'PARALLELE');
 ITYPDEP = VRAI ;
SINON ;
 ITYPDEP = FAUX ;
FINSI ;
*
*---- coordonnees dans le repere du maillage
XM = COOR 1 CONT0 ;
YM = COOR 2 CONT0 ;
SI ((VALEUR DIME) EGA 2) ;
   ZM = XM * 0. ;
SINON ;
   ZM = COOR 3 CONT0 ;
FINSI ;
*
*---- coordonnees dans le repere global
XG YG ZG = @CRMGC XM YM ZM TAB1 ;
MENAGE ;
*
*---- calcul du champ magnetique dans le repere global
BXG BYG BZG FSECU = @CHAMB TAB1 XG YG ZG ISHIFT IRIPPLE ;
MENAGE ;
*
*---- composantes de B dans le repere du maillage
BXM BYM BZM = @CBGMV BXG BYG BZG TAB1 ;
MENAGE ;
*
*---- calcul des normales a la surface calculees
*---- dans le repere du maillage
SI (ICALNORM) ;
   NXM NYM NZM = @VNORM3D MAIL0 CONT0 ;
   TAB1.<NXM = NXM ;
   TAB1.<NYM = NYM ;
   TAB1.<NZM = NZM ;
FINSI;
MENAGE ;
*
*---- calcul du produit scalaire et de l'angle d'incidence
B_NORM = ((BXM*BXM) + (BYM*BYM) + (BZM*BZM))**0.5 ;
VBVN = (ABS ((BXM*NXM) + (BYM*NYM) + (BZM*NZM))) / B_NORM;
ANGINCI = ATG ((1.-(VBVN**2))**0.5) VBVN ;
*
*---- dans le plan xy du repere du maillage
BETA2DXY = ATG (BYM*-1.) (BXM*-1.) ;
*---- dans le plan xz du repere du maillage
BETA2DXZ = ATG (BZM*-1.) (BXM*-1.) ;
*
*---- calcul de Lambdaq et des facteurs de compression
LAMBQ HS HR DELTA = @CLAMQ TAB1 XG YG ZG ISHIFT IRIPPLE ;
MENAGE ;
*
*---- calcul de la densite de puissance recue par chaque point
VAR1 = EXP (DELTA * -1. / LAMBQ) ;
*
*---- profil du flux modif RM le 08/12/1998
SI ITYPDEP ;
 PROFIL0 = VAR1 * VBVN ;
SINON ;
 PROFIL0 = VAR1 * ((1. - (VBVN*VBVN)) ** .5) ;
FINSI ;
*
*---- integration du profil de flux sur la surface
PROCONT0 = NOMC SCAL (FLUX MMAIL0 PROFIL0) ;
*
*---- calcul du profil moyen
PROMOY = (MAXI (RESU PROCONT0)) / (MESU CONT0) ;
*
SI (IMESS >EG 2) ;
   MESS '>>>> @TOKAFLU : BXM '; MESS (MAXI BXM) (MINI BXM) ;
   MESS '>>>> @TOKAFLU : BYM '; MESS (MAXI BYM) (MINI BYM) ;
   MESS '>>>> @TOKAFLU : BZM '; MESS (MAXI BZM) (MINI BZM) ;
   MESS '>>>> @TOKAFLU : PROFIL0 ';
   MESS (MAXI PROFIL0) (MINI PROFIL0) ;
   MESS '>>>> @TOKAFLU : VAR1 '; MESS (MAXI VAR1) (MINI VAR1) ;
   MESS '>>>> @TOKAFLU : ANGINCI ';
   MESS (MAXI ANGINCI) (MINI ANGINCI) ;
FINSI ;
SI (IMESS >EG 3) ;
   MESS '>>>> @TOKAFLU : BXM '; LIST BXM ;
   MESS '>>>> @TOKAFLU : BYM '; LIST BYM ;
   MESS '>>>> @TOKAFLU : BZM '; LIST BZM ;
   MESS '>>>> @TOKAFLU : VBVN '; LIST VBVN ;
   MESS '>>>> @TOKAFLU : BETA2DXY '; LIST BETA2DXY ;
   MESS '>>>> @TOKAFLU : BETA2DXZ '; LIST BETA2DXZ ;
   MESS '>>>> @TOKAFLU : ANGINCI '; LIST ANGINCI ;
   MESS '>>>> @TOKAFLU : PROFIL0 '; LIST PROFIL0 ;
FINSI ;
*
*---- visualisations des resultats en 2D et en 3D
*
MENAGE ;
*---- vecteur champ magnetique et vecteur normal dans le repere
*---- du maillage en vue de la visualisation
VB1 = @CVECT BXM BYM BZM CONT0 VERT;
VN1 = @CVECT NXM NYM NZM CONT0 BLEU;
*
*---- profil de flux visualise dans la direction de la normale rentrante
DNORMX = PROFIL0 * NXM * -1. ;
DNORMY = PROFIL0 * NYM * -1. ;
DNORMZ = PROFIL0 * NZM * -1. ;
VECT1 = @CVECT DNORMX DNORMY DNORMZ CONT0 JAUN ;
*
*---- profil de flux integre visualise dans la direction de la normale
rentrante
FNORMX = PROCONT0 * NXM * -1. ;
FNORMY = PROCONT0 * NYM * -1. ;
FNORMZ = PROCONT0 * NZM * -1. ;
VECT2 = @CVECT FNORMX FNORMY FNORMZ CONT0 JAUN ;
*
*---- traces en 2D
SI (((VALEUR DIME) EGA 2) ET ITRAC) ;
   CONT0 = CONT0 COUL ROUG ;
   TITRE '@TOKAFLU : NORMAL AND MAGNETIC VECTOR' ;
   TRACE (VN1 ET VB1) CONT0 ;
*   TRACE VB1 CONT0 ;
*
*  ---- trace de courbes
   TITRE '@TOKAFLU : DISTANCE TO THE LCFS (m)';
   DELTA1 = NOMC SCAL DELTA ;
   TAB1.1 = 'TIRR';
   DESSIN (EVOL JAUN CHPO DELTA1 SCAL CONTDES0) MIMA TAB1 ;
*
   TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)';
   FSECU1 = NOMC SCAL FSECU ;
   DESSIN (EVOL JAUN CHPO FSECU1 SCAL CONTDES0) MIMA ;
*
   TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
   VBVN1 = NOMC SCAL VBVN ;
   DESSIN (EVOL JAUN CHPO VBVN1 SCAL CONTDES0) MIMA ;
*
   TITRE '@TOKAFLU : angle = arctg (Bz/Bx)' ;
   ANGLE0 = ATG (ABS BZG) (ABS BXG) ;
   ANGLE1 = NOMC SCAL ANGLE0  ;
   DESSIN (EVOL JAUN CHPO ANGLE1 SCAL CONTDES0) MIMA ;
*
*   TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming Bz = 0)';
*   BETA2D1 = NOMC SCAL BETA2DXY ;
*   DESSIN (EVOL JAUN CHPO BETA2D1 SCAL CONTDES0) MIMA ;
*   TITRE 'BETA2D : ANGLE BETWEEN B AND X AXIS (assuming By = 0)';
*   BETA2D2 = NOMC SCAL BETA2DXZ ;
*   DESSIN (EVOL JAUN CHPO BETA2D2 SCAL CONTDES0) MIMA ;
*
   TITRE '@TOKAFLU : COMPRESSION FACTORS HS (shift) AND HR (ripple)';
   TAB1.1 = 'TIRR';
   HS1 = NOMC SCAL HS ;
   HR1 = NOMC SCAL HR ;
   DESSIN ((EVOL ROUG CHPO HR1 SCAL CONTDES0) ET
           (EVOL JAUN CHPO HS1 SCAL CONTDES0)) MIMA TAB1;
*
   TITRE '@TOKAFLU : LAMBDAQ (m)' ;
   LAMBQ1 = NOMC SCAL LAMBQ ;
   DESSIN (EVOL JAUN CHPO LAMBQ1 SCAL CONTDES0) MIMA;
*
   TITRE '@TOKAFLU : EXP (-DELTA / LAMDAQ) ';
   VAR11 = NOMC SCAL VAR1 ;
*AM   DESSIN (EVOL JAUN CHPO VAR11 SCAL CONTDES0) MIMA ;
*
   TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
   PROFIL1 = NOMC SCAL PROFIL0 ;
   DESSIN (EVOL JAUN CHPO PROFIL1 SCAL CONTDES0) MIMA ;
*
   TITRE '@TOKAFLU : PROFILE OF THE INCIDENT FLUX' ;
   TRACE VECT1 CONT0 ;
   TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX' ;
   TRACE VECT2 CONT0 ;
FINSI ;
*
*---- traces en 3D
SI (((VALEUR DIME) EGA 3) ET ITRAC) ;
*
   SI (EGA (VALEUR ELEM) 'CUB8') ;
       ARET1 = ARETE CONT0 ;
   SINON ;
       ARET1 = ARETE CONT0 40. ;
   FINSI ;
   TITRE '@TOKAFLU : MAGNETIC FIELD AND NORMAL VECTOR' ;
   TRACE CACH OEIL0 (VB1 ET VN1) MAIL0 ;
   TITRE '@TOKAFLU : COSINUS OF THE ANGLE BETWEEN b AND n' ;
   TRACE CACH OEIL0 7 VBVN CONT0 ARET1;
* RM 11/06/1997 je commente les deux lignes suivantes,
* car je prefere lui faire tracer 90. - angleinci
*   TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS b AND n (DEGREE)' ;
*   TRACE CACH OEIL0 7 ANGINCI CONT0 ARET1;
   TITRE '@TOKAFLU : ANGLE BETWEEN VECTORS B AND SURFACE (DEGREE)' ;
   TRACE CACH OEIL0 7 (90. - ANGINCI) CONT0 ARET1;
*   TITRE '@TOKAFLU : BETA2DXZ' ;
*   TRACE CACH OEIL0 7 BETA2DXZ CONT0 ARET1;
*   TITRE '@TOKAFLU : BETA2DXY' ;
*   TRACE CACH OEIL0 7 BETA2DXY CONT0 ARET1 ;
   TITRE '@TOKAFLU : NORM OF THE MAGNETIC FIELD (TESLA)' ;
   TRACE CACH OEIL0 7 B_NORM CONT0 ARET1 ;
   TITRE '@TOKAFLU : SAFETY FACTOR Q = (a.Btor/R.Bpol)' ;
   TRACE CACH OEIL0 7 FSECU CONT0 ARET1 ;

   SI (NON (EGA (MAXI LAMBQ) (MINI LAMBQ))) ;
      TITRE '@TOKAFLU : ISOVALUES OF LAMBDAQ (M)' ;
      TRACE CACH OEIL0 7 LAMBQ CONT0  ARET1;
   SINON ;
      MESS '>>> @TOKAFLU >>> Lambdaq constant egal a ' (MAXI LAMBQ) ;
   FINSI ;

   TITRE '@TOKAFLU : DISTANCE TO THE LCFS (M)' ;
   TRACE CACH OEIL0 7 DELTA CONT0 ARET1;

   distmin1 = mini DELTA ;
   mess '>@TOKAFLU> MINIMAL DISTANCE BETWEEN LIMITER AND DSMF'
   distmin1 ;

   TITRE '@TOKAFLU : exp (- delta / lamdaq)' ;
   TRACE CACH OEIL0 7 VAR1 CONT0 ARET1;
   TITRE '@TOKAFLU : PROFILE OF THE INCIDENT HEAT FLUX' ;
*   TRACE OEIL0 VECT1 CONT0 ;
   TRACE CACH OEIL0 7 PROFIL0 CONT0 ARET1 ;
*   TITRE '@TOKAFLU : PROFILE OF THE INTEGRATED INCIDENT FLUX';
*   TRACE OEIL0 VECT2 CONT0 ;
FINSI ;
*
*--------------- VARIABLES DE SORTIE :
TAB1.V_FACFM2 = PROMOY ;
TAB1.<ANGINCI = ANGINCI ;
TAB1.<VBVN = VBVN ;
TAB1.<LONG_DECROIS = LAMBQ ;
TAB1.<DIST_DSMF = DELTA ;
TAB1.<FSECU = FSECU ;
*-------------------------------------
MESS '---------------------------------> exiting @TOKAFLU';
FINPROC PROFIL0 ;
**** @TOKAPEN
DEBPROC @TOKAPEN TAB1*TABLE ;
*
*******************************************************************
* Procedure de prise en compte sommaire de la penetration.        *
* Pour cela, on calcule un profil de flux supplementaire que l'on *
* ajoutera au profil calcule par @TOKAFLU sur une surface donnee. *
*                    Alain MOAL (decembre 1995)                   *
*******************************************************************
*
MESS '---------------------------------> calling @TOKAPEN';
*
*--------------- VARIABLES D'ENTREE :
SURF0    = TAB1.LFLUX_EXTE      ;
SURF1    = TAB1.<LFLUX_PENE     ;
DELTA    = TAB1.<DIST_DSMF      ;
LAMBQ    = TAB1.<LONG_DECROIS   ;
VBVN     = TAB1.<VBVN           ;
COEF0    = TAB1.<COEFCONS       ;
SI ((VALEUR DIME) EGA 3)        ;
   OEIL0 = TAB1.VIEW_P          ;
FINSI                           ;
*------------------------------------
*
*---- Creation d'un masque sur SURF0
MASQ1 = DELTA * 0. ;
*---- Creation d'un masque sur SURF1
X0 = COOR 1 SURF1 ;
MASQ2 = X0 * 0. + 1. ;
*
MASQ0 = MASQ1 + MASQ2 ;
PROFIL0 = (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
PROFPEN0 = MASQ0 * (EXP (-1.*DELTA/LAMBQ)) * VBVN * COEF0;
PROFTOT0 = PROFIL0 + PROFPEN0 ;
SI (EGA (VALEUR DIME) 3) ;
   ARET1 = ARETE SURF0 ;
   TITRE '@TOKAPEN : PROFILE OF THE INCIDENT HEAT FLUX';
   TRACE CACH OEIL0 7 PROFTOT0 SURF0 ARET1 ;
FINSI ;
MESS '---------------------------------> exiting @TOKAPEN';
FINPROC PROFPEN0 ;
debproc @tokpltg geo1*maillage tab1*table
 delt_phi*flottant delt_the*flottant;

* R. Mitteau 23.06.1997
* cette procédure calcule le plan tangent aux surfaces magnetiques
* avec shift et avec ripple
* elle utilise les notations de tokaflu
*
* geo1 est suppose defini dans le repere du ripple
* elle ne marche qu'en 3 D
* *******************************************************
*
* --- recuperatiion données
*
COEFA   =  TAB1.<COEFA   ;
COEFB   =  TAB1.<COEFB   ;
COEFC   =  TAB1.<COEFC   ;
ANGPHI0 =  TAB1.<ANGPHI0 ;
NBOB    =  TAB1.<NBOB    ;
EPS     =  TAB1.<EPS     ;
NBOB    =  TAB1.<NBOB    ;
rho0    =  TAB1.<RHO0    ;
g_lamb1 =  TAB1.<LAMB    ;
RP1     =  TAB1.<RP      ;
*
* --- calcul des coordonnees de geo1 dans le repere du ripple
*
xg yg zg  = @crmgc (coor 1 geo1) (coor 2 geo1) (coor 3 geo1) tab1 ;
rho_ar theta_ar phi_ar = @crgtc  xg yg zg 2.2 0.;
*
* --- calcul du rhomer, ligne de code pique a @chamb
*

RHO_OLD = RHO_aR ;
KAUX = (EXP(THETA_aR**2 * -1. * COEFC)) *
         ((COS((PHI_aR + ANGPHI0) * NBOB)) * -1. + 1.) * COEFA ;
I = 0 ;
IMAX = 50 ;
REPETER BOUCLE IMAX ;
 I = I + 1;
 RHO_NEW = RHO_aR + (KAUX * (EXP(RHO_OLD * COEFB))) ;
 SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) <EG EPS) ;
  QUITTER BOUCLE ;
 FINSI ;
 RHO_OLD = RHO_NEW ;
FIN BOUCLE ;
SI (I >EG IMAX) ;
 MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
 ERRE ' >>> STOP IN @CHAMB';
FINSI ;
RHOMER = RHO_NEW ;
*
* --- calcul du premier vecteur tangent a la surface magnetique par
*     variation de phi - l'effet dont il faut
*     tenir compte est le ripple du champ magnetique
*
* - _app signifie a plus phi, point cote plus dans le sens toroidal
*
the_app = theta_ar ;
phi_app = phi_ar + delt_phi ;
rho_app = RHOMER + (COEFA *
     (exp((COEFB * RHOMER)-(coefc * the_app * the_app)))
         * ((cos (nbob * phi_app)) - 1.));

* - _app signifie a moins phi, point cote moins dans le sens toroidal

the_amp = theta_ar ;
phi_amp = phi_ar - delt_phi ;
rho_amp = RHOMER + (COEFA * (exp((COEFB * RHOMER)-
     (coefc * the_amp * the_amp)))
         * ((cos (nbob * phi_amp)) - 1.));


* on repasse dans la base globale

ppx1 ppy1 ppz1 = @crtgc rho_app  the_app phi_app  2.2 0. ;
pmx1 pmy1 pmz1 = @crtgc rho_amp  the_amp phi_amp  2.2 0. ;

* par difference, on calcule les coordonnee du premier vecteur tangent

v1gx  = ppx1 -  pmx1;
v1gy  = ppy1 -  pmy1 ;
v1gz  = ppz1 -  pmz1 ; ;

* on repasse dans la base du maillage

v9mx v9my v9mz = @cbgmv v1gx v1gy v1gz tab1 ;

* on le normalise

norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
v1mx = v9mx / norm1 ;
v1my = v9my / norm1 ;
v1mz = v9mz / norm1 ;


*
* --- calcul du deuxieme vecteur tangent a la surface magnetique par
*     variation de theta - l'effet principal dont il faut
*     tenir compte est le shift de Shafranov
*

* calcul du petit rayon "sous les bobines" de la surface magnetique
* passant par A

rho_abob = RHOMER +
     (COEFA * (exp((COEFB * RHOMER)-(coefc * the_app * the_app)))
         * ( -2.));

* calcul du decentrement de ces surfaces par la formule de Safranov

terme1  = log (rho_abob / rho0 ) ;
facteu1 = g_lamb1  + .5 ;
facteu2 = 1. - ((rho_abob/ rho0) ** -2) ;
terme2  = terme1 + (facteu1 * facteu2) ;
* delt1 est le decentrement
delt1 = (rho_abob ** 2) * terme2  / (2. * RP1) ;
rp2 = RP1 - delt1  ;

* calcul du petit rayon de la surface magnetique de A
* (relation dans le triangle)

pr2 = ((rho_abob * rho_abob) +
 ((rp2 - 2.2) * (rp2 - 2.2)) -
(2. * rho_ar * (rp2 - 2.2) *( cos (theta_ar)))) ** .5 ;

* calcul de l'angle theta des points de geo1 dans le repere
* pseudotoroidal de grand rayon le centre de la surface magnetique

coth2 = ((pr2 * pr2)
        + ((rp2 - 2.2) * (rp2 - 2.2))
        - (rho_abob * rho_abob)) / (-2. * pr2 * (rp2 - 2.2));

sith2 = (1. - (coth2 * coth2)) ** .5 ;

theta_ap = atg sith2 coth2 ;

* les masques servent a bien avoir un theta entre -180 et +180,
* parce que le sinus calcule par la formule 1 - cos carre
* est forcement positif, ce qui me donne un theta compris entre
* 0 et 180.

masq_p = masq theta_ar egsupe    0. ;
masq_m = masq theta_ar inferieur 0. ;

theta_as = (masq_p * theta_ap) - ( theta_ap * masq_m );

* _apt signifie a plus theta
* _amt signifie a moins theta

the_apt = theta_as + delt_the ;
the_amt = theta_as - delt_the ;

* on repasse dans le repere du ripple !

* calcul des petits rayon des points dans le repere du ripple
* (toujours la formule du triangle, faire le dessin pour
* comprendre le cos (180. - the_apt) que je n'ai pas remplace par
* - cos the_apt pour la lisibilite de la procedure.

pr3_apt = ((pr2 * pr2) +
 ((rp2 - 2.2) * (rp2 - 2.2)) -
(2. * pr2 * (rp2 - 2.2) *( cos (180. - the_apt)))) ** .5 ;

pr3_amt = ((pr2 * pr2) +
 ((rp2 - 2.2) * (rp2 - 2.2)) -
(2. * pr2 * (rp2 - 2.2) *( cos (180. - the_amt)))) ** .5 ;

* calcul des theta dans le repere du ripple

coth2apt  = ((pr3_apt * pr3_apt)
        + ((rp2 - 2.2) * (rp2 - 2.2))
        - (pr2 * pr2)) / (2. * pr3_apt * (rp2 - 2.2));

coth2amt  = ((pr3_amt * pr3_amt)
        + ((rp2 - 2.2) * (rp2 - 2.2))
        - (pr2 * pr2)) / (2. * pr3_amt * (rp2 - 2.2));

sith2apt = (1. - (coth2apt * coth2apt)) ** .5 ;
sith2amt = (1. - (coth2amt * coth2amt)) ** .5 ;

thetaapt = atg sith2apt coth2apt ;
thetaamt = atg sith2amt coth2amt ;

the_apt = (masq_p * thetaapt) - ( thetaapt * masq_m );
the_amt = (masq_p * thetaamt) - ( thetaamt * masq_m );

* par la methode du point fixe, je peux calculer leur rho meridien
* pr4  est le prefixe pour des valeurs de rho meridien

RHO_OLD = pr3_apt ;
KAUX = (EXP(the_apt**2 * -1. * COEFC)) * 2. * COEFA ;
I = 0 ;
IMAX = 50 ;
REPETER BOUCLE IMAX ;
 I = I + 1;
 RHO_NEW = pr3_apt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
 SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) <EG EPS) ;
  QUITTER BOUCLE ;
 FINSI ;
 RHO_OLD = RHO_NEW ;
FIN BOUCLE ;
SI (I >EG IMAX) ;
 MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
 ERRE ' >>> STOP IN @CHAMB';
FINSI ;
pr4_apt = RHO_NEW ;

RHO_OLD = pr3_amt ;
KAUX = (EXP(the_amt**2 * -1. * COEFC)) * 2. * COEFA ;
I = 0 ;
IMAX = 50 ;
REPETER BOUCLE IMAX ;
 I = I + 1;
 RHO_NEW = pr3_amt + (KAUX * (EXP(RHO_OLD * COEFB))) ;
 SI ((MAXI (ABS((RHO_NEW - RHO_OLD) / RHO_NEW))) <EG EPS) ;
  QUITTER BOUCLE ;
 FINSI ;
 RHO_OLD = RHO_NEW ;
FIN BOUCLE ;
SI (I >EG IMAX) ;
 MESS '>>> @CHAMB : NO CONVERGENCE OF THE ITERATIVE METHOD !';
 ERRE ' >>> STOP IN @CHAMB';
FINSI ;
pr4_amt = RHO_NEW ;

* il n y a plus qu'a calculer le rho de ces points au bon phi par la
* formule de ripple

pr5_apt = COEFA * (exp((COEFB * pr4_apt)-(coefc * the_apt * the_apt)))
         * ((cos (nbob * phi_ar)) - 1.);

pr5_amt = COEFA * (exp((COEFB * pr4_amt)-(coefc * the_amt * the_amt)))
         * ((cos (nbob * phi_ar)) - 1.);

* on a maintenant les coordonnee des tous les points dans le repere
* du ripple pr5_apt; the_apt , phi_ar et pr5_amt; the_amt , phi_ar

* on repasse dans la base globale

p1gx p1gy p1gz = @cbtgv pr5_apt the_apt phi_ar the_apt phi_ar ;
p2gx p2gy p2gz = @cbtgv pr5_amt the_amt phi_ar the_amt phi_ar;

* on calcule par difference les vecteurs dan le repere global

v2gx = p1gx - p2gx ;
v2gy = p1gy - p2gy ;
v2gz = p1gz - p2gz ;

* on repasse dans la base du maillage

v9mx v9my v9mz = @cbgmv v2gx v2gy v2gz tab1 ;

* on le normalise

norm1 =(( v9mx*v9mx)+(v9my*v9my)+(v9mz*v9mz)) ** .5 ;
v2mx = v9mx / norm1 ;
v2my = v9my / norm1 ;
v2mz = v9mz / norm1 ;


* --- le produit vectoriel des deux vecteurs tangent a la surface
*     donne la normale aux surfaces magnetiques
*
v3mx = (v1my * v2mz) - (v1mz * v2my);
v3my = (v1mz * v2mx) - (v1mx * v2mz)  ;
v3mz = (v1mx * v2my) - (v1my * v2mx)  ;

*norm1 =(( v3mx*v3mx)+(v3my*v3my)+(v3mz*v3mz)) ** .5 ;
*list norm1 ;
finproc v3mx v3my v3mz;
**** @TONG75
DEBPROC  @TONG75  TAB_1*TABLE    ;
MESS ' ';
*23456789012345678901234567890123456789012345678901234567890123456789012
*        1         2         3         4         5         6         7
******              PROCEDURE @TONG75                ******
********************************************************************
* CALCUL DU FLUX CRITIQUE SUIVANT LA CORRELATION DE TONG 75
*-------------------------------------------------------------------
*
*
*
TIN      = TAB_1.'T_IN'                                     ;
VIN      = TAB_1.'V_LOCAL'                                     ;
TLOCAL   = TAB_1.'T_LOCAL'                                     ;
POUT     = TAB_1.'P_LOCAL'                                     ;
D1       = TAB_1.'D_MAQUETTE'                                  ;
EL       = TAB_1.'L_HEATED'                                    ;
XL1      = TAB_1.'WE_HEATED'                                   ;
NIVEAU   = TAB_1.'NIVEAU' ;
HLOCAL   = TAB_1.'HLOCAL' ;
*
SI (NIVEAU >EG 4) ;
 MESS '-----------------------------------> calling @TONG75';
FINSI ;

SI ( NON ( EXISTE TAB_1 TWIST_RATIO  ) )                           ;
  TAB_1 . TWIST_RATIO = 0.                                         ;
  MESS '>@TONG75> TAB1.TWIST_RATIO  set to default value : 0'      ;
FINSI                                                              ;
YTWIST  = TAB_1 . TWIST_RATIO                                      ;

SI ( NON ( EXISTE TAB_1 T_TAPE ) )                                 ;
 TAB_1 . T_TAPE = 0.                                               ;
 MESS '>@TONG75> TAB1.T_TAPE        set to default value : 0'      ;
FINSI                                                              ;
TTAPE   = TAB_1 . T_TAPE                                           ;

SI ( NON ( EXISTE TAB_1 I_CORR_SANDIA  ) )                         ;
 TAB_1 . I_CORR_SANDIA = 0.                                        ;
 MESS '>@TONG75> TAB1.I_CORR_SANDIA set to default value : 0'      ;
FINSI                                                              ;
ICORSA  = TAB_1 . I_CORR_SANDIA                                    ;

SI( NON ( EXISTE TAB1 I_RANGE ))                                   ;
 TAB1 . I_RANGE = 1                                                ;
FINSI                                                              ;
IVALI   = TAB_1 . I_RANGE                                          ;

SI( NON ( EXISTE TAB1 I_NIV_TONG75 ))                              ;
 TAB1 . I_NIV_TONG75  = 1                                          ;
FINSI                                                              ;
INIVEAU = TAB_1 . I_NIV_TONG75                                     ;

SI ( NON ( EXISTE TAB_1 HELI_WIRE ) )                              ;
 TAB_1.HELI_WIRE = FAUX                                            ;
 MESS '>@TONG75> TAB1.HELI_WIRE    set to default value : FAUX'   ;
FINSI                                                              ;

SI ( NON ( EXISTE TAB_1 HYPERVAP ) )                               ;
 TAB_1.HYPERVAP = FAUX                                             ;
 MESS '>@TONG75> TAB1.HYPERVAP     set to default value : FAUX'  ;
FINSI                                                              ;

SI ( NON ( EXISTE TAB_1 FRICT_FAC ) )                              ;
 TAB_1.FRICT_FAC = FAUX                                            ;
 MESS '>@TONG75> TAB1.FRICT_FAC    set to default value : FAUX'   ;
FINSI                                                              ;
MESS ' '   ;

SI ( NON ( EXISTE TAB_1 DESACT_RANGE ) )                              ;
 DESACT1 = FAUX                                            ;
 MESS '>@TONG75> TAB1.FRICT_FAC    set to default value : FAUX'   ;
SINON;
 DESACT1 = VRAI                                            ;

FINSI                                                              ;
MESS ' '   ;

SI (NON DESACT1  )                                         ;

* Test sur les entrees pour s'assurer que les conditions d'entree
* ne s'ecartent pas trop du domaine de definition de TONG75


* - test sur la vitesse de l'eau
SI ((VIN < 2.) OU (VIN > 20.))                                        ;
 MESS 'Water inlet velocity out of Tong75 range 2.- 20.'              ;
 ERRE '@TONG75 --> Inlet velocity'                                    ;
FINSI                                                                 ;

* - test sur le diametre
SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  SI ((D1 < 5.E-3) OU (D1 > 20.E-3))                                  ;
   MESS 'Tube diameter out of Tong75 range 5.E-3 - 20.E-3'            ;
   ERRE '@TONG75 --> Tube diameter'                                   ;
  FINSI                                                               ;
FINSI ;

* - test sur la Pression
SI ((POUT < 5.E5) OU (POUT > 42.E5))                                  ;
 MESS 'Water pressure out of Tong75 range 5.E5 - 42.E5'               ;
 ERRE '@TONG75 --> Pressure'                                          ;
FINSI                                                                 ;

* - test sur la temperature
TSAT  =  @IPOE  POUT  TAB_1.EPTSAT                                   ;
DT1   = TSAT - TLOCAL                                                 ;
SI ((DT1 < 0.) OU (DT1 > 250.))                                       ;
 MESS 'Temperature out of Tong75 range 0. - 250.'                     ;
 ERRE '@TONG75 --> Temperature'                                       ;
FINSI                                                                 ;

FINSI ;
SI ( IVALI EGA 1 )                                             ;

 ISAUT = 0                                                        ;
 SI ( ( POUT < 2.E5 ) OU ( POUT > 190.E5 ) )                      ;
  MESS '>@TONG75> PRESSURE REALLY OUT OF TONG75 RANGE POUT = ' POUT;
  MESS '>@TONG75> PRESSURE  RANGE 2.E5 - 190.E5 ' ;
  ISAUT = 1                                                     ;
 FINSI                                                            ;
 SI ( EGA TAB_1.HYPERVAP FAUX ) ;
  SI ( ( D1 < 2.E-3 ) OU ( D1 > 45.E-3 ) )                         ;
   MESS '>@TONG75> DIAMETER REALLY OUT OF TONG75 RANGE DIAM = ' D1 ;
   MESS '>@TONG75> DIAMETER  RANGE 2.E-3 - 45.E-3 ' ;
   ISAUT = 1                                                     ;
  FINSI                                                            ;
 FINSI ;
 SI ( ( EL < 0.15 ) OU ( EL > 3.7 ) )                             ;
  MESS '>@TONG75> LENGTH REALLY OUT OF TONG75 RANGE EL = ' EL   ;
  MESS '>@TONG75> LENGTH  RANGE 0.15 - 3.7 ' ;
  ISAUT = 1                                                     ;
 FINSI                                                            ;
FINSI                                                               ;

* Fin des tests sur les entrees de @TONG75

PI  = 3.14159                                                    ;
*
SI ( ( YTWIST EGA 0. ) ET ( EGA TAB_1.HYPERVAP FAUX ) )          ;
 TAB_1.DHC = D1                                                  ;
 S1  = PI * D1 * D1 / 4.                                         ;
 TAB_1.DH = D1                                                   ;
 FACV =  1.                                                      ;
 FACS =  1.25                                                    ;
 TAB_1.M_TONG = MOT '1.25*TONG75'                                ;
FINSI                                                            ;
SI ( ( YTWIST EGA 0. )  ET  ( EGA TAB_1.HELI_WIRE VRAI ) )       ;
 S1 = PI * D1 * D1 / 4.                                          ;
 SM = PI * TAB_1.WIRE_D * TAB_1.WIRE_D / 4.                      ;
 P1 = PI * D1                                                    ;
 PM = PI * TAB_1.WIRE_D                                          ;
 TAB_1.DH = 4. * ( S1 - SM ) / ( P1 + PM )                        ;
 PIS2Y = PI / ( 2 * TAB_1.PITCH_WIRE )                           ;
 FACV =  ( 1. + ( PIS2Y ** 2 ) ) ** 0.5                          ;
* FACV =  1.                                                      ;
 FACF =  1.                                                      ;
FINSI                                                            ;
*
SI ( ( TAB_1.TWIST_RATIO EGA 0. 1.E-6 )  ET
      ( EGA TAB_1.HYPERVAP VRAI ) )    ;
 SM =  ( TAB_1 . LARG_CANAL * TAB_1 . HMIN_CANAL ) +
      ( 2. * ( TAB_1 . LARG_ESP * TAB_1 . HFIN ) )              ;
 PM = TAB_1 . LARG_CANAL + ( 2.* TAB_1 . HMAX_CANAL ) +
      ( 2. * TAB_1 . LARG_ESP ) + ( 2. * TAB_1 . HFIN ) +
        TAB_1 . LFIN                                             ;
 TAB_1.DH = 4. * SM / PM                                        ;
 FACV =  1.                                                      ;
 FACF =  1.                                                      ;
 TAB_1.HYP_SM = SM ;
 FACS = 1. ;
 TAB_1.M_TONG = MOT 'TONG75'                                     ;
FINSI                                                            ;
*
SI ( YTWIST > 0. )                                               ;
 SI ( NON ( EXISTE  TAB_1  'N_CANAUX' ))                         ;
    TAB_1 . N_CANAUX = 2.                                        ;
 FINSI                                                           ;
 SS2  = ( ( PI * D1 * D1 / 8.) - ( TTAPE * D1 / 2. ) )           ;
 S1   =  SS2 *    TAB_1 . N_CANAUX                               ;
 QUAS = 4. * SS2                                                 ;
 PERI =      ( ( PI * D1 / 2.) -  TTAPE + D1        )            ;
 TAB_1.DH   =  QUAS / PERI                                             ;
 TAB_1.DHC = 4. * ( ( PI * D1 * D1 / 4.) - ( TTAPE * D1  ) ) /
                 ( ( PI * D1     ) -  ( TTAPE * 2.)  )           ;
 PIS2Y =           PI / ( 2. * YTWIST )                          ;
 FACV = ( 1. + ( PIS2Y ** 2 )  )  ** 0.5                         ;
* FACF =  1.15                                                   ;
 FACS =  1.67                                                    ;
 TAB_1.M_TONG = MOT '1.67*TONG75'                                ;
FINSI                                                            ;
*-----------------
VP   = VIN * FACV                                                ;
*-----------------

SI (( YTWIST > 0.  ) ET ( ICORSA EGA 1 ) )                    ;
 CORR = SCALE * 2.75 * ( YTWIST ** ( -0.406 ) )               ;
  SI ( CORR <EG  1.  )                                        ;
   CORR = 1.                                                  ;
  FINSI                                                       ;
SINON                                                         ;
 CORR = 1.                                                    ;
FINSI                                                         ;

RHOIN  =  @IPOE  TIN    TAB1.ETRHOF                            ;
HSAT    = @IPOE  TSAT     TAB_1.ETHF                           ;
RHOGSAT = @IPOE  TSAT     TAB_1.ETRHOG                         ;
GIN    =  RHOIN * VIN                                          ;
NNU     = @IPOE  TLOCAL     TAB_1.ETNNU                        ;
PR      = @IPOE  TLOCAL     TAB_1.ETPRAF                       ;
*HFG    = @IPOE  TLOCAL     TAB_1.ETHFG                        ;
HFG     = @IPOE  TSAT       TAB_1.ETHFG                        ;
* RHOF rho de l eau a TLOCAL PTRHO PRHOF
RHOF    = @IPOE  TLOCAL     TAB_1.ETRHOF                       ;
RHOFSAT = @IPOE  TSAT     TAB_1.ETRHOF                         ;
DTSUBC =  TSAT - TLOCAL                                        ;

*Reynolds number based on inlet velocity used in QCHFW1 and QCHFW3
REF     = ( RHOF * VIN * TAB_1.DH ) / NNU                         ;

* Friction factor calculation
SI ( EGA TAB_1.FRICT_FAC VRAI )                                     ;
 FA = 4. * 1.375E-3 *
      (( 1. + ( 21.544 * ( 0.00375 /( TAB_1.DH * 1000. / 2. )))
      + ( 100. / REF )) ** ( 1. / 3. ))                             ;
 TAB_1.SSIGM = @IPOE TSAT TAB_1.ETSIGM                              ;
 SIGM = TAB_1.SSIGM                                                 ;
 RHOFSAT = @IPOE  TSAT     TAB_1.ETRHOF                             ;
 REPETER BOUCFA 100                                                 ;
  RADEFF = 1.14 - ( 2. * (
  LOG ((( 0.72 * SIGM * RHOFSAT ) / ( FA * TAB_1.DH * ( GIN**2 )))
  + ( 9.35 / ( REF *( FA **( 1. / 2. ))))))/( LOG 10 ))             ;
  DIF1 = ( RADEFF ** (-2))- FA                                      ;
  DELTAF = ABS (DIF1)                                               ;
  FA = RADEFF**(-2)                                                 ;
  TAB_1.FFA = FA                                                    ;
  SI (DELTAF <EG 1.E-6)                                             ;
   QUITTER BOUCFA                                                   ;
  FINSI                                                             ;
 FIN BOUCFA                                                         ;
 QCHFW1 = TAB_1.FFA                                                 ;
SINON                                                               ;
*Reference diameter (0.5 inch) used for friction factor coefficient
 DOM   = 12.7E-3                                                    ;
 DRATIO = TAB_1.DH / DOM                                            ;
 QCHFW1 =  8. * ( REF ** ( -.6 ) ) * ( DRATIO ** .32 )              ;
FINSI                                                               ;
*Water critical pressure
PCRIT = 22.09E6                                                     ;
PRATIO = POUT / PCRIT                                               ;
XOUT   =  -1. * ( HSAT - HLOCAL ) / HFG                             ;
*>> 30.8.93 correction erreur sur JA
*JA     = -1. * XOUT * ( RHOFSAT / RHOGSAT )                        ;
JA     = -1. * XOUT * ( RHOF / RHOGSAT )                            ;
QCHFW3 =  1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REF ** .5 ) * JA )  ;
QCHFW2 = 0.23 * GIN * HFG                                           ;
QCHFW =  FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3                     ;

*Expression using REV
*Reynolds number based on swirl velocity
REV     = ( RHOF * VP * TAB_1.DH ) / NNU                            ;
*QCHFW3 =  1. + ( .00216 * ( PRATIO ** 1.8 ) * ( REV ** .5 ) * JA ) ;
*QCHFW1 =  8. * ( REV ** ( -.6 ) ) * ( DRATIO ** .32 )              ;
*QCHFW =  FACS * CORR * QCHFW1 * QCHFW2 * QCHFW3                    ;

*QCHFW =  ( 0.9 * QCHFW ) + ( 0.1 * QOLD )                          ;
*QSURFE = QCHFW * KQ                                                ;
*QSURFI = QSURFE * XL1 / PERCH                                      ;
*DQSQ = ( QCHFW - QOLD ) / QCHFW                                     ;
*NUS = 0.023 * ( REV ** 0.8 ) * ( PR ** 0.4 ) ;
*NUS = NUS * FACV * FACF                             ;
*FACD =  ( D1 / DH ) ** 0.2                 ;
*FACT = FACV * FACD * FACF                             ;

SI ( INIVEAU >EG 1 )                                                ;
 MESS '  '                  ;
 MESS '>@TONG75>  THERMAL HYDRAULIC CONDITIONS '        ;
 MESS '  '                  ;
 MESS '>@TONG75>  INLET VELOCITY             (m/s) : ' VIN ;
* MESS '>@TONG75>  INLET MASS FLOW RATE      (kg/s) : '
*                                        (VIN * S1 * RHOIN)    ;
* MESS '>@TONG75>  FLUID INLET TEMPERATURE      (C) : ' TIN ;
 MESS '>@TONG75>  FLUID LOCAL TEMPERATURE      (C) : ' TLOCAL;
 MESS '>@TONG75>  FLUID OUTLET PRESSURE       (Pa) : ' POUT ;
 MESS '>@TONG75>  WATER SATURATION TEMPERATURE (C) : ' TSAT ;
 MESS '>@TONG75>  SUBCOOLING TSAT - TLOCAL     (C) : ' DTSUBC;
 MESS ' ' ;
 MESS '>@TONG75>  GEOMETRICAL CONDITIONS '              ;
 MESS ' ' ;
 MESS '>@TONG75>  TUBE DIAMETER                (m) : ' D1   ;
 MESS '>@TONG75>  TUBE HYDRAULIC DIAMETER      (m) : ' TAB_1.DH    ;
* MESS '>@TONG75>  TUBE HEATED EQU. DIAMETER   (m) : ' TAB_1.DHC  ;
 MESS '>@TONG75>  HEATED LENGTH                (m) : ' EL   ;
 MESS '>@TONG75>  HEATED WIDTH                 (m) : ' XL1  ;
 MESS '>@TONG75>  SWIRL TAPE THICKNESS         (m) : ' TTAPE ;
 MESS '>@TONG75>  TWIST RATIO                      : ' YTWIST ;
 SI ( INIVEAU >EG 2 )                                         ;
  MESS '>@TONG75>  REYNOLDS NUMBER BASED ON SWIRL VELOCITY    : ' REV;
  MESS '>@TONG75>  REYNOLDS NUMBER BASED ON VIN               : ' REF ;
  MESS '>@TONG75>  QUALITY                                    : ' XOUT;
  MESS '>@TONG75>  JAKOB NUMBER                               : ' JA  ;
  MESS '>@TONG75>  PRANDTL  NUMBER                            : ' PR  ;
  MESS '>@TONG75>  CORRECTIVE FACTOR SANDIA                   : ' CORR;
  SI ( INIVEAU >EG 3 )                                     ;
   MESS '>@TONG75> LOCAL FLUID DENSITY      (kg/m**3) : ' RHOF      ;
   MESS '>@TONG75> GAS SATUR.  DENSITY      (kg/m**3) : ' RHOGSAT   ;
   MESS '>@TONG75> VAPORISATION ENTHALPY       (J/kg) : ' HFG       ;
   MESS '>@TONG75> OUTLET FLUID VISCOSITY    (kg/m.s) : ' NNU       ;
   MESS '>@TONG75> Q1 Q2 Q3        '        QCHFW1 QCHFW2 QCHFW3    ;
  FINSI                                                    ;
 FINSI                                                     ;
 MESS ' ' ;
 MESS '>@TONG75>                                   : ' TAB_1.M_TONG;
 MESS '>@TONG75> CRITICAL HEAT FLUX         (W/m2) : '  QCHFW    ;
 MESS ' ' ;
FINSI                                                       ;
SCALE = 0.8                                                 ;

SI (QCHFW < 0)                                             ;
 MESS ' '                                                  ;
 MESS '!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!'      ;
 MESS ' '                                                  ;
 MESS 'ATTENTION execution incorrecte de @TONG75'           ;
 MESS ' '                                                  ;
 MESS '--------------------------------------------'       ;
 MESS ' Le flux critique est negatif '                     ;
 ERRE ' On arrete le calcul'                               ;
FINSI                                                      ;
SI( NIVEAU >EG 4)
 MESS '-----------------------------------> exit from  @TONG75';
FINSI ;

*sorties      ;
TAB1.CHF = QCHFW ;

FINPROC       ;
**** TORO
DEBPROC TORO TAGEO*TABLE TABOB*TABLE ;
*
* Developpement et test de la procedure TORO
* Projet DRFC/TO_PO Contrat n 30422676
*
opti dime 3 elem cub8 echo 0 ;
**********************************************************************
*                                                                    *
*                          T O R O                                   *
*                          -------                                   *
*                                                                    *
* Objet:                                                             *
* -----                                                              *
*                                                                    *
* Calcul de l'induction magnetique creee par un ensemble             *
* de bobines circulaires ou en 'D', reparties regulierement          *
* autour de l'axe Oz, en l'absence de fer.                           *
*                                                                    *
* Syntaxe:                                                           *
* -------                                                            *
*                                                                    *
* TABCHB TAB2 = TORO TAGEO1 TABOB1 ;                                 *
*                                                                    *
* En entree :                                                        *
*                                                                    *
*                                                                    *
* TAGEO1        table des domaines de calcul du champ                *
*    TAGEO1.i   geometrie ou le champ est calcule (type TABLE)       *
*    TAGEO1.i.'mail' : maillage de la geometrie (type MAILLAGE)      *
*                                                                    *
* TABOB         table a deux indices contenant les donnees           *
*               relatives aux bobines (type TABLE)                   *
*       .GENE    table                                               *
*             .1 nbob: nombre de bobines (type ENTIER)               *
*             .2 b: largeur des bobines (type FLOTTANT)              *
*             .3 h: hauteur des bobines (type FLOTTANT)              *
*             .4 cbob: centre de la bobine (type POINT)              *
*             .5 vn: vecteur normal au plan de la bobine (type POINT)*
*             .6 tsol: table des solenations des bobines             *
*                     .i solenation (courant * nombre de spires)     *
*                        de la bobine i (type FLOTTANT)              *
*             .7 rt: rayon du tore (type FLOTTANT)                   *
*             .8 ri: nombre de bobines (type FLOTTANT)               *
*       .TYPE     'c' pour une bobine circulaire                     *
*                 'd' pour une bobine en 'D'                         *
*       .TRAC1 si oui : trace du maillage des bobines (type LOGIQUE) *
*       .CBIOT si oui : calcul de l'induction magnetique             *
*       .D       = troncon : table des troncons:                     *
*                  troncon.j = troncj : table du troncon j:          *
*                     troncj.'l' longueur du troncon si rectiligne,  *
*                           .'r' rayon de courbure et                *
*                           .'alpha' angle de courbure si courbe     *
*                                                                    *
* En sortie :                                                        *
*                                                                    *
*                                                                    *
* TABCHB        table contenant (type TABLE)                         *
*    i          champ de Biot et Savart relatif au i-eme             *
*               maillage GEO1 (type CHPOINT)                         *
*                                                                    *
* TAB2          table contenant (type TABLE)                         *
* BOBMAI.i      maillage de chaque bobine (type MAILLAGE)            *
* CONT.j        ensemble des coupes sur le plan j                    *
*               (type MAILLAGE)                                      *
*                                                                    *
* Remarques:                                                         *
* ---------                                                          *
*                                                                    *
* Les grandeurs suivantes sont "en dur" dans la procedure :          *
*                                                                    *
* NELE          nombre d'elements generes lors des rotations         *
*               et des translations effectuees pendant la            *
*               creation du maillage des bobines.                    *
*                                                                    *
* COEF1         coefficient etablissant la distance critique         *
*               de selection des points lors de la recherche         *
*               de contour.                                          *
*                                                                    *
**********************************************************************
isym = 0 ;
*
* Valeurs de quelques constantes
*
pi = 3.1415926 ;
mu0 = 4.e-7 * pi ;
eps = 1.e-3 ;
nele = 4 ;
alpha = 90. ;
oeil = 100. 20. 10. ;
*
* creation du maillage
*
tab2 = table ;
tabmai = table ;
tab2.bobmai = tabmai ;
ibob = 1 ;
repeter proc 1 ;
   sauter 1 ligne ;
   mess ' ************ procedure TORO' ;
   sauter 1 ligne ;
   ngeo = dime tageo1 ;
   si (ega ngeo 0) ;
*tc il ajout d' une quote en fin de la ligne suivante
      mess ' **** Il n y a pas de domaine de calcul ';
   sinon ;
      si (ega ngeo 1) ;
         mess ' **** Il y a un seul domaine de calcul' ;
      sinon ;
*tc idem ci dessus
         mess ' **** Il y a' ngeo 'domaines de calcul' ;
      finsi ;
   finsi ;
   si (existe tabob type) ;
      typbob = tabob.type ;
   sinon ;
      mess '  ***  erreur : indice type inexistant' ;
      quitter proc ;
   finsi ;
   si (existe tabob gene) ;
      tcara = table ;
      tcara = tabob.gene ;
      si (existe tcara 1) ;
         nbob*entier = tcara.1 ;
      sinon ;
         mess ' *** erreur ; il manque nbob !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 2) ;
         b*flottant = tcara.2 ;
      sinon ;
         mess ' *** erreur ; il manque b !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 3) ;
         h*flottant = tcara.3 ;
      sinon ;
         mess ' *** erreur ; il manque nbob !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 4) ;
         cbob*point = tcara.4 ;
      sinon ;
         mess ' *** erreur ; il manque cbob !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 5) ;
         v*point = tcara.5 ;
      sinon ;
         mess ' *** erreur ; il manque v !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 6) ;
         tabsol = table ;
         tabsol = tcara.6 ;
      sinon ;
         mess ' *** erreur ; il manque tabsol !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 7) ;
         rt*flottant = tcara.7 ;
      sinon ;
         mess ' *** erreur ; il manque rt !!' ;
         quitter proc ;
      finsi ;
      si (existe tcara 8) ;
         ri*flottant = tcara.8 ;
      sinon ;
         mess ' *** erreur ; il manque ri !!' ;
         quitter proc ;
      finsi ;
   sinon ;
      mess '  ***  erreur : indice gene inexistant' ;
   finsi ;
*
   si (ega typbob 'c') ;
       sauter 1 ligne ;
       mess ' ******* bobine circulaire *********' ;
   sinon;
      si (ega typbob 'd') ;
          si (existe tabob 'd') ;
             sauter 1 ligne ;
             mess ' ******* bobine en D *********' ;
             sauter 1 ligne ;
          sinon;
             mess ' erreur bobine D : indice d inexistant' ;
          finsi;
      sinon;
         mess '*********  erreur bobine  ***********' ;
         quitter proc ;
      finsi;
   finsi ;
*-----------------------------------------------------------------
*       fin de l'analyse syntaxique
*-----------------------------------------------------------------
   c1 c2 c3 = coor cbob ;
   o1 = cbob plus (0. (0. - rt) 0.) ;
   o2 = o1 plus (0. 0. 10.) ;
*
*  calcul du vecteur norme vnor normal au plan de la bobine
*
   v1 v2 v3 = coor v ;
*
   vn = ( (v1**2) + (v2**2) + (v3**2) )**0.5 ;
   si (vn ega 0.);
      mess '  ***  erreur: vecteur vn nul !' ;
      quitter proc ;
   finsi  ;
   vn1 = v1/vn ; vn2 = v2/vn ; vn3 = v3/vn ;
   vnor = vn1 vn2 vn3 ;
   ovn = o1 plus (v1 v2 v3) ;
*
*  calcul du vecteur norme wn normal a vnor (dans le plan de la bobine
*   et dans le plan xOy) et du vecteur t tangent au troncon
*
   si (vn3 ega 0.);
      t0 = 0. 0. 1. ;
      wn = pvec t0 vnor ;
   sinon ;
      si ( (non (ega vn1 0.)) ou (non (ega vn2 0.)) ) ;
         wn = pvec (0. 0. 1.) vnor ;
         t0 = pvec vnor wn ;
      sinon ;
         wn = 0. 1. 0. ;
         t0 = 1. 0. 0. ;
      finsi ;
   finsi ;
   xt0 yt0 zt0 = coor t0 ;
   t = t0 plus (0. 0. 0.) ;
   wn1 wn2 wn3 = coor wn ;
*-----------------------------------------------------------
* test sur le domaine de calcul
*-----------------------------------------------------------
   itest = table ;
   igeo1 = 0 ;
   repeter bgeo1 ngeo ;
      igeo1 = igeo1 + 1 ;
      si (existe tageo1 igeo1) ;
          lmot = ((tageo1.igeo1).'mail') elem 'TYPE' ;
          nbeldom = nbel (tageo1.igeo1).'mail' ;
          nmot = dime lmot ;
          imot = 0 ;
          repeter boutyp nmot ;
            imot = imot + 1 ;
            mot1 = extr lmot imot ;
            mess ' *** domaine numero' igeo1
                 'compose de' nbeldom 'elements ' mot1 ;
            sauter 1 ligne ;
* domaine plan
             si ( (ega mot1 'TRI3') ou (ega mot1 'QUA4') ou
                  (ega mot1 'TRI6') ou (ega mot1 'QUA8') ) ;
                elem1 = ((tageo1.igeo1).'mail') elem 1 ;
                elem2 = chan poi1 elem1 ;
                pel1 = elem2 poin 1 ;
                pel2 = elem2 poin 2 ;
                pel3 = elem2 poin 3 ;
                zpel1 = coor 3 pel1 ;
                zpel2 = coor 3 pel2 ;
                zpel3 = coor 3 pel3 ;
                phori = (ega zpel1 zpel2 1.E-5) et
                        (ega zpel1 zpel3 1.E-5) ;
                si (phori) ;
                   (tageo1.igeo1).'ZP' = zpel1 ;
                   (tageo1.igeo1).'PP' = pel1 ;
                   (tageo1.igeo1).'VP' = 0. 0. 1. ;
                   pequa = phori et (ega zpel1 0.) ;
                   si (pequa et (ega v3 0.)) ;
                      itest.igeo1 = 0 ;
                      isym = 1 ;
                   sinon ;
                      si ((ega typbob 'c') et (ega v3 0.)) ;
* calcul analytique pour une bobine circulaire verticale
                         itest.igeo1 = 1 ;
                      sinon ;
* calcul d'intersection de Denis
                         itest.igeo1 = 2 ;
                      finsi ;
                   finsi ;
                sinon ;
                   itest.igeo1 = -2 ;
                finsi ;
                quitter boutyp ;
            sinon ;
* domaine volumique
               itest.igeo1 = -1 ;
            finsi ;
         fin boutyp ;
*         sauter 1 ligne ;
*         mess '  ****** itest =' itest.igeo1 ;
*         sauter 1 ligne ;
      sinon ;
         quitter bgeo1 ;
      finsi ;
   fin bgeo1 ;
*--------------------------------------------------------------
*  construction des points de la section initiale de la bobine
*--------------------------------------------------------------
   re = ri + b ;
   p11 = c1 + (ri*wn1) - ((h/2.)*vn1) ;
   p12 = c2 + (ri*wn2) - ((h/2.)*vn2) ;
   p13 = c3 + (ri*wn3) - ((h/2.)*vn3) ;
   p21 = c1 + (re*wn1) - ((h/2.)*vn1) ;
   p22 = c2 + (re*wn2) - ((h/2.)*vn2) ;
   p23 = c3 + (re*wn3) - ((h/2.)*vn3) ;
   p31 = c1 + (re*wn1) + ((h/2.)*vn1) ;
   p32 = c2 + (re*wn2) + ((h/2.)*vn2) ;
   p33 = c3 + (re*wn3) + ((h/2.)*vn3) ;
   p41 = c1 + (ri*wn1) + ((h/2.)*vn1) ;
   p42 = c2 + (ri*wn2) + ((h/2.)*vn2) ;
   p43 = c3 + (ri*wn3) + ((h/2.)*vn3) ;
*
* points de la base
*
   p1 = p11 p12 p13 ; p2 = p21 p22 p23 ;
   p3 = p31 p32 p33 ; p4 = p41 p42 p43 ;
* barycentre de la base:
   pp11 = (p11 + p21 + p31 + p41)/4. ;
   pp12 = (p12 + p22 + p32 + p42)/4. ;
   pp13 = (p13 + p23 + p33 + p43)/4. ;
   pp1 = pp11 pp12 pp13 ;
*
* segments de la base
*
   d1 = droi 1 p1 p2 ; d2 = droi 1 p2 p3 ;
   d3 = droi 1 p3 p4 ; d4 = droi 1 p4 p1 ;
   cont1 = p1 d 1 p2 d 1 p3 d 1 p4 d 1 p1 ;
*
   cvn = cbob plus (vn1 vn2 vn3) ;
*-----------------------------------------
*  construction des surfaces laterales
*-----------------------------------------
   si (ega typbob 'c') ;
      tquart = table ;
      pp2 = pp1 tour alpha cbob cvn ;
*
      surf1 = d1 rota nele alpha cbob cvn ;
      surf2 = d2 rota nele alpha cbob cvn ;
      surf3 = d3 rota nele alpha cbob cvn ;
      surf4 = d4 rota nele alpha cbob cvn ;
*
      surfbo1 = surf1 et surf2 et surf3 et surf4 ;
      tquart.1 = surfbo1 ;
      xn1 = (vn2*wn3) - (vn3*wn2) ;
      xn2 = (vn3*wn1) - (vn1*wn3) ;
      xn3 = (vn1*wn2) - (vn2*wn1) ;
      p51 = c1 + (ri*xn1) - ((h/2.)*vn1) ;
      p52 = c2 + (ri*xn2) - ((h/2.)*vn2) ;
      p53 = c3 + (ri*xn3) - ((h/2.)*vn3) ;
      p61 = c1 + (re*xn1) + ((h/2.)*vn1) ;
      p62 = c2 + (re*xn2) + ((h/2.)*vn2) ;
      p63 = c3 + (re*xn3) + ((h/2.)*vn3) ;
      p5 = p51 p52 p53 ; p6 = p61 p62 p63 ;
      surfbo2 = surfbo1 syme plan cbob p5 p6 ;
*
      tquart.2 = surfbo2 ;
      tquart.3 = surfbo2 syme plan cbob p1 p2 ;
      tquart.4 = surfbo1 syme plan cbob p1 p2 ;
      cont2 = cont1 syme plan cbob p5 p6 ;
      demisurf = (surfbo1 et surfbo2) ;
   finsi ;
*-------------------------------------------------
   si (ega typbob 'd') ;
      troncon = table ;
      troncon = tabob.'d' ;
      ntron = dime troncon ;
*      mess ' ****************** Il y a' ntron 'troncons' ;
      itron = 1 ;
      troncj = table ;
      repeter btron ntron ;
         troncj = troncon.itron ;
         si ( (existe troncj 'l') et (non (existe troncj 'r')) et
              (non (existe troncj 'alpha')) ) ;
            mess ' ******  troncon no' itron 'rectiligne' ;
            lj = troncj.'l' ;
            si (itron ega 1) ;
               pp2 = pp1 plus ((xt0*lj) (yt0*lj) (zt0*lj)) ;
               vdir = (xt0*lj) (yt0*lj) (zt0*lj) ;
            sinon ;
               xt yt1 zt1 = coor t ;
               xpp2 ypp2 zpp2 = coor pp2 ;
               pp1 = xpp2 ypp2 zpp2 ;
               xg = xt*lj ;
               yg = yt1*lj ;
               zg = zt1*lj ;
               pp2 = pp1 plus (xg yg zg) ;
               vdir = xg yg zg ;
            finsi ;
            surf1 = d1 tran nele vdir ;
            d1 = d1 plus vdir ;
            surf2 = d2 tran nele vdir ;
            d2 = d2 plus vdir ;
            surf3 = d3 tran nele vdir ;
            d3 = d3 plus vdir ;
            surf4 = d4 tran nele vdir ;
            d4 = d4 plus vdir ;
            surfboj = surf1 et surf2 et surf3 et surf4 ;
*
* conservation des points definissant le troncon rectiligne
*
            troncj.'pp1' = pp1 ;
            troncj.'pp2' = pp2 ;
            troncj.'pp3' = cbob ;
         sinon ;
            si ( (existe troncj 'r') et (existe troncj 'alpha')
               et (non (existe troncj 'l')) ) ;
               mess ' ******  troncon no' itron 'courbe' ;
               rj = troncj.'r' ;
               alphaj = troncj.'alpha' ;
               si (itron ega 1) ;
                  si (dbob > 0.) ;
                     crj = cbob plus (0. (dbob - rj) 0.) ;
                  sinon ;
                     crj = cbob plus (0. (dbob + rj) 0.) ;
                  finsi ;
               sinon ;
                  xpp2 ypp2 zpp2 = coor pp2 ;
                  pp1 = xpp2 ypp2 zpp2 ;
                  xt yt1 zt1 = coor t ;
*  vecteur norme vr perpendiculaire a vnor et t
                  si (alphaj > 0.) ;
                     vr = vnor pvec t ;
                  sinon ;
                     vr = t pvec vnor ;
                  finsi ;
                  xvr yvr zvr = coor vr ;
                  xcrj = xpp2 + ((rj+(b/2.))*xvr) ;
                  ycrj = ypp2 + ((rj+(b/2.))*yvr) ;
                  zcrj = zpp2 + ((rj+(b/2.))*zvr) ;
                  crj = xcrj ycrj zcrj ;
               finsi ;
               cvn = crj plus (vn1 vn2 vn3) ;
               surf1 = d1 rota nele alphaj crj cvn ;
               d1 = d1 tour alphaj crj cvn ;
               surf2 = d2 rota nele alphaj crj cvn ;
               d2 = d2 tour alphaj crj cvn ;
               surf3 = d3 rota nele alphaj crj cvn ;
               d3 = d3 tour alphaj crj cvn ;
               surf4 = d4 rota nele alphaj crj cvn ;
               d4 = d4 tour alphaj crj cvn ;
               surfboj = surf1 et surf2 et surf3 et surf4 ;
*
*  barycentre de la section finale
*
               pp2 = pp1 tour alphaj crj cvn ;
* conservation du point definissant le centre du troncon courbe
               troncj.'crj' = crj ;
*
* construction du nouveau vecteur tangent t (par rotation de alphaj)
*
               t = t tour alphaj o1 ovn ;
               troncj.'pp1' = pp1 ;
               troncj.'pp2' = pp2 ;
            sinon ;
               mess ' erreur : troncon mal defini ' ;
               quitter proc ;
            finsi ;
         finsi ;
         troncj.'mail' = surfboj ;
         si (itron ega 1) ;
            demisurf = surfboj ;
         sinon ;
            demisurf = demisurf et surfboj ;
         finsi ;
         troncon.itron = troncj ;
         itron = itron + 1 ;
      fin btron ;
      cont2 = d1 et d2 et d3 et d4 ;
      elim 1.E-3 cont2 ;
*---------------------------------------------------------
* construction des troncons inferieurs par symetrie / xOy
*---------------------------------------------------------
      si (ega isym 0);
         itron = 1 ;
         repeter btron2 ntron ;
            troncj = troncon.itron ;
            itron2 = (2*ntron) - itron + 1 ;
            troncj2 = table ;
            troncj2.'mail' = (troncj.'mail') syme plan o1 cbob cvn ;
            si ( (existe troncj 'r') et (existe troncj 'alpha')
              et (non (existe troncj 'l')) ) ;
                crj = (troncj.'crj') syme plan cbob p1 p2  ;
                pp1 = (troncj.'pp2') syme plan cbob p1 p2  ;
                pp2 = (troncj.'pp1') syme plan cbob p1 p2  ;
                troncj2.'crj' = crj ;
                troncj2.'pp1' = pp1 ;
                troncj2.'pp2' = pp2 ;
                troncj2.'r' = troncj.'r' ;
                troncj2.'alpha' = troncj.'alpha' ;
            finsi ;
            si ( (existe troncj 'l') et (non (existe troncj 'r')) et
               (non (existe troncj 'alpha')) ) ;
                pp1 = (troncj.'pp2') syme plan cbob p1 p2  ;
                pp2 = (troncj.'pp1') syme plan cbob p1 p2  ;
                troncj2.'pp1' = pp1 ;
                troncj2.'pp2' = pp2 ;
                troncj2.'pp3' = cbob ;
                troncj2.'l' = troncj.'l' ;
            finsi ;
            troncon.itron2 = troncj2 ;
            itron = itron + 1 ;
         fin btron2 ;
      finsi ;
   finsi ;
*----------------------------------------------------------------------
* construction du symetrique du maillage de la bobine par rapport a xOy
*----------------------------------------------------------------------
   surfbob = demisurf et (demisurf syme plan cbob p1 p2 ) ;
   elim eps surfbob ;
   mess 'construction de la premiere bobine effectuee' ;
*-----------------------------------------------------------
* construction des autres bobines par rotation autour de Oz
*-----------------------------------------------------------
   ibob = 1 ;
   tabmai.ibob = surfbob ;
   surftot = surfbob ;
   si (nbob > 1) ;
      repeter bbob (nbob-1) ;
         ibob = ibob + 1 ;
         angln = (ibob-1)*360./nbob ;
         surfbobn = surfbob tour angln o1 o2 ;
         tabmai.ibob = surfbobn ;
         surftot = surftot et tabmai.ibob ;
         mess 'construction de la bobine' ibob 'effectuee' ;
      fin bbob ;
   finsi ;
*
* construction des axes
*
   x1 = (2.*rt) 0. 0. ;
   y1 = 0. (2.*rt) 0. ;
   z1 = 0. 0. (2.*rt) ;
   axes = (o1 d 1 x1) et (o1 d 1 y1) et (o1 d 1 z1) ;
   axes = axes coul rouge ;
   si (ega tabob.trac1 'oui') ;
      trac oeil cach (surftot et axes) ;
   finsi ;
fin proc ;
****************************************
* calcul des champs de biot et savart  *
****************************************
tabchb = table ;
tab2.cont = table ;
re = ri + b ;
igeo1 = 0 ;
si (ega tabob.cbiot 'oui') ;
   repeter bogeo1 ngeo ;
      igeo1 = igeo1 + 1 ;
      mess ' *** Domaine de calcul du champ numero' igeo1 ;
      si (itest.igeo1 > -1) ;
         tabcon = table ;
      finsi ;
      si (existe tageo1 igeo1) ;
         geo1 = (tageo1.igeo1).'mail' ;
         chp0 = manu chpo geo1 3 bx 0. by 0. bz 0. ;
         ibob = 0 ;
         repeter bbob2 nbob ;
            ibob = ibob + 1 ;
            si (existe tabsol ibob) ;
               sol = tabsol.ibob ;
               dens = sol/(b*h) ;
            finsi ;
            si (ega typbob 'c') ;
               mess ' *** BIOT ; induction magnetique cree par '
                    'la bobine circulaire numero' ibob ;
               mess 'dont la solenation est' sol ;
               sauter 1 ligne ;
               si (ega ibob 1) ;
                  chb1 = biot geo1 cerc cbob pp1 pp2 ri re h dens mu0 ;
               sinon ;
                  anglj = 360./nbob ;
                  cbob = cbob tour anglj o1 o2 ;
                  pp1 = pp1 tour anglj o1 o2 ;
                  pp2 = pp2 tour anglj o1 o2 ;
                  chb1 = chb1 et
                 (biot geo1 cerc  cbob  pp1  pp2 ri re h dens mu0) ;
               finsi ;
            sinon ;
               sauter 1 ligne ;
               mess ' *** BIOT ; induction magnetique cree par '
                    'la bobine en D numero' ibob ;
               mess 'dont la solenation est' sol ;
               sauter 1 ligne ;
               itron = 0 ;
               ntron = dime troncon ;
               repeter bbob3 ntron ;
                  itron = itron + 1 ;
                  troncj = troncon.itron ;
*
*  troncon courbe
*
                si ( (existe troncj 'r') et (existe troncj 'alpha') ) ;
*                     mess ' troncon numero' itron;
                     ri = troncj.'r' ;
                     re = ri + b ;
                     crj = troncj.'crj' ;
                     pp1 = troncj.'pp1' ;
                     pp2 = troncj.'pp2' ;
*                     mess '** ri' ri ;
*                     list crj ;
*                     list pp1 ;
*                     list pp2 ;
                     si ( (ega ibob 1) et (ega itron 1) ) ;
                        mess ' *** premier troncon courbe ' ;
                 chb1 = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
                     sinon ;
                        mess ' *** troncon courbe numero' itron;
                        si (ibob > 1) ;
                           teta = (ibob - 1)*360./nbob ;
                           tcrj = crj tour teta o1 o2 ;
                           tpp1 = pp1 tour teta o1 o2 ;
                           tpp2 = pp2 tour teta o1 o2 ;
             chb1j = biot geo1 arc tcrj tpp1 tpp2 ri re h dens mu0 ;
                           chb1 = chb1 et chb1j ;
                        sinon ;
                chb1j = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
                           chb1 = chb1 et chb1j ;
                        finsi ;
                     finsi ;
                  finsi ;
*
*  troncon rectiligne
*
                  si (existe troncj 'l') ;
*                     mess ' troncon numero' itron;
                     pp1 = troncj.'pp1' ;
                     pp2 = troncj.'pp2' ;
                     pp3 = troncj.'pp3' ;
*                     list pp1 ;
*                     list pp2 ;
*                     list pp3 ;
                     si ((ega ibob 1) et (ega itron 1));
                        mess ' *** premier troncon rectiligne' ;
                        chb1 = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
                     sinon ;
                        mess ' *** troncon rectiligne numero' itron;
                        si (ibob > 1) ;
                           teta = (ibob - 1)*360./nbob ;
                           tpp1 = pp1 tour teta o1 o2 ;
                           tpp2 = pp2 tour teta o1 o2 ;
                           tpp3 = pp3 tour teta o1 o2 ;
                    chb1j = biot geo1 barr tpp1 tpp2 tpp3 b h dens mu0 ;
                           chb1 = chb1 et chb1j ;
                        sinon ;
                    chb1j = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
                           chb1 = chb1 et chb1j ;
                        finsi ;
                     finsi ;
                  finsi ;
                 si (ega isym 1) ;
                    mess ' ***** calcul du champ par symetrie / xOy ' ;
                    si ( (ega ibob 1) et (ega itron 1) ) ;
                       chb1x = exco 'BX' chb1 'BX' ;
                       chb1y = exco 'BY' chb1 'BY' ;
                       chb1z = exco 'BZ' chb1 'BZ' ;
                       chb2z = chb1z*(-1.) ;
                       chb2 = chb1x et chb1y et chb2z ;
                       chb1 = chb1 et chb2 ;
                    sinon ;
                       chb1x = exco 'BX' chb1j 'BX' ;
                       chb1y = exco 'BY' chb1j 'BY' ;
                       chb1z = exco 'BZ' chb1j 'BZ' ;
                       chb2z = chb1z*(-1.) ;
                       chb2 = chb1x et chb1y et chb2z ;
                       chb1 = chb1 et chb2 ;
                    finsi ;
                finsi ;
              fin bbob3 ;
           finsi ;
        fin bbob2 ;
        tabchb.igeo1 = chb1 ;
*----------------------------------------------------
* calcul des intersections pour le plan igeo1
*----------------------------------------------------
        si (ega itest.igeo1 0) ;
           tabcon.1 = cont1 et cont2 ;
        finsi ;
        si (ega itest.igeo1 1) ;
*----------------------------------------------------------------
*  calcul analytique de l'intersection d'une bobine circulaire
*       verticale avec un plan
*----------------------------------------------------------------
            mess ' **** calcul analytique dans le cas'
                           'de la bobine circulaire' ;
            sauter 1 ligne ;
            zp = (tageo1.igeo1).'ZP' ;
            mess ' **** plan a la cote' zp ;
            x1 = h/2.;
            cbob*point = tcara.4 ;
            cxn = cbob plus (1. 0. 0.) ;
            czn = cbob plus (0. 0. 1.) ;
            si (zp < ri) ;
               cos1 = ((ri**2.) - (zp**2.) )**0.5 ;
               beta1 = atg zp cos1 ;
               y1 = ri*(cos beta1) ;
               pc1 = cbob plus (x1 y1 zp) ;
               pc2 = cbob plus ( (0. - x1) y1 zp ) ;
*
               cos2 = ((re**2.) - (zp**2.) )**0.5 ;
               beta2 = atg zp cos2 ;
               y2 = re*(cos beta2) ;
               pc3 = cbob plus (x1 y2 zp) ;
               pc4 = cbob plus ( (0. - x1) y2 zp ) ;
*
               cont1 = pc1 d 1 pc2 d 1 pc4 d 1 pc3 d 1 pc1 ;
               tabcon.1 = cont1 et (cont1 syme plan cbob cxn czn) ;
            sinon ;
               si (zp < re) ;
                  cos2 = ((re**2.)- (zp**2.) )**0.5 ;
                  beta2 = atg zp cos2 ;
                  y2 = re*(cos beta2) ;
                  pc1 = cbob plus (x1 y2 zp) ;
                  pc2 = cbob plus ( (0. - x1) y2 zp ) ;
                  pc3 = pc2 syme plan cbob cxn czn ;
                  pc4 = pc1 syme plan cbob cxn czn ;
                  cont1 = pc1 d 1 pc2 d 1 pc3 d 1 pc4 d 1 pc1 ;
                  tabcon.1 = cont1 ;
               sinon ;
                  mess ' ***** le plan ne coupe pas les bobines !!' ;
               finsi ;
            finsi ;
            si (non (ega vn2 0.)) ;
                gama1 = atg vn2 vn1 ;
                tabcon.1 = tabcon.1 tour gama1 cbob czn ;
            finsi ;
         finsi ;
         si (ega itest.igeo1 2) ;
*            mess 'Algorithme Denis Robert' ;
*------------------------------------------------------------------
*   Algorithme de recherche des contours des bobines
*------------------------------------------------------------------
            repeter bouci 1 ;
           'SAUTER' 1 'LIGNE' ;
           'MESS' 'Contour des bobines dans le domaine' igeo1 ;
           'MESS' '-------------------------------------------' ;
           TABLIG   = TABLE ;
           TAB2.LIG = TABLIG ;
           COUP1 = tageo1.igeo1 ;
           IRECUP = 0 ;
             'SI' ( 'EXISTE' COUP1 'PP' ) ;
                 PP*'POINT' = COUP1.'PP' ;
             'SINON' ;
                'SAUTER' 1 'LIGNE' ;
                'MESS' 'Erreur : il manque PP pour le plan ' igeo1 ;
                'SAUTER' 1 'LIGNE' ;
                IERR = 1 ; 'QUITTER' BOUCI;
             'FINSI' ;
             'SI' ( 'EXISTE' COUP1 'VP' ) ;
                 VP*'POINT' = COUP1.'VP' ;
             'SINON' ;
                'SAUTER' 1 'LIGNE' ;
                'MESS' 'Erreur : il manque VP pour le plan ' igeo1 ;
                'SAUTER' 1 'LIGNE' ;
                IERR = 1 ; 'QUITTER' BOUCI ;
             'FINSI' ;
*
*     Trois points vont definir ce plan : PP PP2 et PP3
*
              PP11 PP12 PP13 = COORD PP ;
              VP1 VP2 VP3 = COORD VP ;
*
*     Vecteur WN tq : VP1 WN1 + VP2 WN2 + VP3 WN3 = 0
*
              VPN1 = ( (VP1**2) + (VP2**2) + (VP3**2) ) ** 0.5 ;
              'SI' ( VPN1 'EGA' 0. ) ;
                  'SAUTER' 1 'LIGNE' ;
                  'MESS' 'ERREUR : plan ' igeo1 ' le vecteur VP est nul' ;
                  'SAUTER' 1 'LIGNE' ;
                  IERR = 1 ; 'QUITTER' BOUCI ;
              'FINSI' ;
              VN1 = VP1 / VPN1 ; VN2 = VP2 / VPN1 ; VN3 = VP3 / VPN1 ;
              VPN = VN1 VN2 VN3 ;
             'SI' ( VN1 'NEG' 0. ) ;
                 'SI' ( VN2 'NEG' 0. ) ;
                     'SI' ( VN3 'NEG' 0. ) ;
                          W2 = VN3 / VN2 ; W3 = -1 ;
                          WN = ( (W2**2) + (W3**2) ) ** 0.5 ;
                          WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;
                     'SINON' ;
                          WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
                     'FINSI' ;
                 'SINON' ;
                     'SI' ( VN3 'NEG' 0. ) ;
                          WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;
                     'SINON' ;
                          WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
                     'FINSI' ;
                 'FINSI' ;
              'SINON' ;
                  WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;
              'FINSI' ;
*
               XN1 = (VN2 * WN3) - (VN3 * WN2) ;
               XN2 = (VN3 * WN1) - (VN1 * WN3) ;
               XN3 = (VN1 * WN2) - (VN2 * WN1) ;
*
*     WN et XN forment une base du plan de coupe
*
               PP21 = PP11 + WN1 ; PP22 = PP12 + WN2 ;
               PP23 = PP13 + WN3 ; PP31 = PP11 + XN1 ;
               PP32 = PP12 + XN2 ; PP33 = PP13 + XN3 ;
               PP2 = PP21 PP22 PP23 ; PP3 = PP31 PP32 PP33 ;
*
*     Intersection de ce plan avec la bobine IBO
*
               IINTER = 0 ;
*
*           On traite separement chaque troncon
*
               IINTEI = 0 ;
               itron = 0 ;
               si (ega typbob 'd') ;
                  ntron = dime tabob.'d' ;
               sinon ;
                  ntron = 4 ;
               finsi ;
              'REPETER' boutron ntron ;
                  itron = itron + 1 ;
                  si (ega typbob 'd') ;
                     MAI0 = (tabtron.itron).'mail' ;
                  sinon ;
                     MAI0 = tquart.itron ;
                  finsi ;
                  MAI1 = 'CHANGER' 'POI1' MAI0 ;
                  NBP1 = 'NBNO' MAI1 ;
                  'MESS' '---> troncon de bobine : ' itron ;
                  'MESS' '---> Nbre de pts     : ' NBP1 ;
                  IP1 = 1 ;
                  IDESSOUS = 0 ; IDESSUS = 0 ; IDEDANS = 0 ;
                  DMOY = 0. ;
                  'REPETER' BOUCPOI1 NBP1 ;
                      PO1 = MAI1 'POIN' IP1 ;
                      POX1 POY1 POZ1 = 'COORD' PO1 ;
                      MX1 = POX1 - PP11 ; MY1 = POY1 - PP12 ;
                      MZ1 = POZ1 - PP13 ;  M1 = MX1 MY1 MZ1 ;
                      PDT1 = M1 'PSCAL' VPN ;
                      DMOY = DMOY + ('ABS' (PDT1)) ;
                      'SI' ( ( 'ABS' PDT1 ) < 0.001 ) ;
                          IDEDANS = IDEDANS + 1 ;
                      'FINSI' ;
                      'SI' ( PDT1 '<EG' -0.001 ) ;
                          IDESSOUS = IDESSOUS + 1 ;
                      'FINSI' ;
                      'SI' ( PDT1 '>EG' 0.001 ) ;
                          IDESSUS = IDESSUS + 1 ;
                      'FINSI' ;
                      'SI' ( IP1 'EGA' 1 ) ;
                         LISPDT = 'PROG' PDT1 ;
                      'SINON' ;
                         LISPDT = LISPDT 'ET' ( 'PROG' PDT1 ) ;
                      'FINSI' ;
                      IP1 = IP1 + 1 ;
                  'FIN' BOUCPOI1 ;
*+*
*+*            Distance de selection des points a projeter
*+*            on divise DMOY par 2 si NELE = 4
*+*                               3           8
               COEF1 = 2. ;
               DMOY = DMOY / NBP1 ;
               DCRIT = DMOY / COEF1 ;
*
*              tests sur la repartition des points / plan de coupe
*
               'SI' ( IDEDANS '>EG' 4 ) ;
                  ICAS = 1 ;
               'SINON' ;
                  'SI' ( IDESSUS > IDESSOUS ) ;
                     ICAS = 2 ;
                  'SINON' ;
                     ICAS = 3 ;
                  'FINSI' ;
               'FINSI' ;
*
               'SI' ((( IDESSOUS '>EG' 1 ) 'ET' ( IDESSUS '>EG' 1 ))
                     'OU' ( IDEDANS '>EG' 1 )) ;
                  IINTER = IINTER + 1 ;
                  IINTEI = IINTEI + 1 ;
                     'MESS' 'Il y a une intersection ...' ;
*
*                 On ne retient que les points les plus proches du
*                 plan de coupe Pc
*
                  IREC = 0 ;
                  'REPETER' BOUCREC 7 ;
                     IREC = IREC + 1 ;
                     IP2 = 1 ; IOK = 0 ;
                     'REPETER' BOUCTRI NBP1 ;
                        VAL1 = 'EXTRAIRE' LISPDT IP2 ;
            'SI' ( ( ICAS 'EGA' 1 ) et (('ABS' VAL1 ) '<EG' 0.001) );
                               IOK = IOK + 1 ;
                              'SI' ( IOK 'EGA' 1 ) ;
                                 MAI2 = MAI1 'POIN' IP2 ;
                              'SINON' ;
                                 MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
                              'FINSI' ;
                       'FINSI ' ;
                       'SI' ( ( ICAS 'EGA' 2 ) et
             ((('ABS' VAL1 ) '<EG' DCRIT ) 'ET' ( VAL1 '>EG' 0.001)) );
                               IOK = IOK + 1 ;
                              'SI' ( IOK 'EGA' 1 ) ;
                                  MAI2 = MAI1 'POIN' IP2 ;
                              'SINON' ;
                                  MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
                              'FINSI' ;
                       'FINSI' ;
                       'SI' ( (ICAS 'EGA' 3 ) et
                 ((('ABS' VAL1 ) '<EG' DCRIT ) 'ET' (VAL1 < -0.001)) );
                             IOK = IOK + 1 ;
                              'SI' ( IOK 'EGA' 1 ) ;
                                  MAI2 = MAI1 'POIN' IP2 ;
                              'SINON' ;
                                  MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
                              'FINSI' ;
                       'FINSI' ;
                        IP2 = IP2 + 1 ;
                    'FIN' BOUCTRI ;
                     list iok ;
                     si (iok > 1) ;
                        NBP2 = 'NBNO' MAI2 ;
                     sinon ;
                        NBP2 = 1 ;
                     finsi ;
                     'MESS' '---> Distance critique      : ' DCRIT ;
                     'MESS' '---> Nbre de points retenus : ' NBP2 ;
                     'MESS' '---> iok : ' iok ;
                     'SI' ( NBP2 < 4 ) ;
                        'SI' ( IREC '<EG' 6 ) ;
                           'MESS' 'Pas assez de points selectionnes' ;
                           'MESS' 'essai nouvelle distance critique' ;
                           DCRIT = DCRIT * 1.25 ;
                        'SINON' ;
                           'MESS' 'Mauvaise selection des points : ' ;
                           'MESS' 'contour introuvable !' ;
                           IERR = 1 ; 'QUITTER' BOUCREC ;
                        'FINSI' ;
                     'SINON' ;
                        'QUITTER' BOUCREC ;
                     'FINSI' ;
                  'FIN' BOUCREC ;
                  si (ega iok 1) ;
                     iterer boutron ;
                     mess ' *** Il y a un point selectionne ! ' ;
                  finsi ;
*
*                 Construction de LIGi
*
                  POIPROJ = MAI2 'PROJ' VP 'PLAN' PP PP2 PP3 ;
*
*                 recherche de WMIN, XWMIN et d'un point oppose
*
                  II1 = 1 ;
                  NBP1 = 'NBNO' POIPROJ ;
                  'REPETER' BOUCP1 NBP1 ;
                     PE1 = POIPROJ 'POIN' II1 ;
                     PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
                     VV1 = PEX1 - PP11 ;
                     VV2 = PEY1 - PP12 ;
                     VV3 = PEZ1 - PP13 ;
                     PEW1 = (VV1 * WN1) + (VV2 * WN2) + (VV3 * WN3) ;
                     PEX1 = (VV1 * XN1) + (VV2 * XN2) + (VV3 * XN3) ;
                     'SI' ( II1 'EGA' 1 ) ;
                        LW = 'PROG' PEW1 ; LX = 'PROG' PEX1 ;
                        WMIN = PEW1 ; XWMIN = PEX1 ;
                        IIMIN = 1 ;
                     'SINON' ;
                        LW = LW 'ET' ( 'PROG' PEW1 ) ;
                        LX = LX 'ET' ( 'PROG' PEX1 ) ;
                        'SI' ( PEW1 < WMIN ) ;
                           WMIN = PEW1 ; XWMIN = PEX1 ;
                           IIMIN = II1 ;
                        'FINSI' ;
                     'FINSI' ;
                     II1 = II1 + 1 ;
                  'FIN' BOUCP1 ;
*
                  II2 = 1 ; DIAG0 = 0. ;
                  'REPETER' BOUCP2 NBP1 ;
                     LW1 = 'EXTRAIRE' LW II2 ;
                     LX1 = 'EXTRAIRE' LX II2 ;
                     DIAG1 = ( ((LW1 -  WMIN) ** 2) +
                               ((LX1 - XWMIN) ** 2) ) ** 0.5 ;
                     'SI' ( DIAG1 > DIAG0 ) ;
                        DIAG0 = DIAG1 ;
                        IIMAX = II2 ;
                     'FINSI' ;
                     II2 = II2 + 1 ;
                  'FIN' BOUCP2 ;
                  PC1 = POIPROJ 'POIN' IIMIN ;
                  PCX1 PCY1 PCZ1 = 'COORD' PC1 ;
                  PC2 = POIPROJ 'POIN' IIMAX ;
                  PCX2 PCY2 PCZ2 = 'COORD' PC2 ;
*
*                 PQ = PC2 - PC1
*
                  PQX1 = PCX2 - PCX1;
                  PQY1 = PCY2 - PCY1;
                  PQZ1 = PCZ2 - PCZ1;
                  PQ = PQX1 PQY1 PQZ1 ;
*
*                 PN = PQ ^ VN
*
                  PNX1 = (PQY1 * VN3) - (PQZ1 * VN2) ;
                  PNY1 = (PQZ1 * VN1) - (PQX1 * VN3) ;
                  PNZ1 = (PQX1 * VN2) - (PQY1 * VN1) ;
                  PN = PNX1 PNY1 PNZ1 ;
*
*                 Recherche des deux autres points -> PC3 et PC4
*
                  II3 = 1 ;
                  PSCAMAX = 0. ; PSCAMIN = 0. ;
                  'REPETER' BOUCP3 NBP1 ;
                     PE1 = POIPROJ 'POIN' II3 ;
                     PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
                     VV1 = PEX1 - PCX1 ;
                     VV2 = PEY1 - PCY1 ;
                     VV3 = PEZ1 - PCZ1 ;
                     PSC1 = (VV1 * PNX1) + (VV2 * PNY1) +
                        (VV3 * PNZ1) ;
                     'SI' ( PSC1 > PSCAMAX ) ;
                        PSCAMAX = PSC1 ; IIMAX = II3 ;
                     'FINSI' ;
                     'SI' ( PSC1 < PSCAMIN ) ;
                        PSCAMIN = PSC1 ; IIMIN = II3 ;
                     'FINSI' ;
                     II3 = II3 + 1 ;
                  'FIN' BOUCP3 ;
                  PC3 = POIPROJ 'POIN' IIMAX ;
                  PC4 = POIPROJ 'POIN' IIMIN ;
                  L1 = 'DROITE' 1 PC1 PC3 ; L2 = 'DROITE' 1 PC3 PC2 ;
                  L3 = 'DROITE' 1 PC2 PC4 ; L4 = 'DROITE' 1 PC4 PC1 ;
                  LIG1 = L1 'ET' L2 'ET' L3 'ET' L4 ;
                  LIG1 = LIG1 'COUL' vert ;
                  mess ' ***** iinter =' iinter ;
                  'SI' (IINTER 'EGA' 1) ;
                       LB = LIG1 ;
                  'SINON' ;
                       LB = LB 'ET' LIG1 ;
                  'FINSI' ;
               'SINON' ;
                  'DETR' MAI1 ; 'DETR' LISPDT ;
               'FINSI' ;
*               IMAI = IMAI + 1 ;
            'FIN' boutron ;
            'SI' ( IINTEI '>EG' 1 ) ;
       'MESS' 'Dans le plan' igeo1 ',' iintei 'contours ont ete crees' ;
             sinon ;
           mess ' **** il n y a pas d intersection dans le plan' igeo1 ;
            'FINSI' ;
      'FIN' BOUCI ;
*
*     Archivage de l'intersection dans TAB2.LIG.j
*
      'SI' (( IINTER '>EG' 1 ) 'OU' ( IRECUP 'EGA' 1 )) ;
         tabcon.1 = LB ;
      'FINSI' ;
       sauter 1 ligne ;
       mess ' ************ fin du calcul des intersections *******' ;
   finsi ;
   sinon ;
      iterer bogeo1 ;
   finsi ;
   si (ega itest.igeo1 -2) ;
       mess ' **** le plan de calcul choisi n est pas horizontal!!' ;
   finsi ;
*-------------------------------------------------------------------------
*
*  construction des contours des autres bobines par rotation autour de Oz
*
*-------------------------------------------------------------------------
   si ((itest.igeo1) > -1) ;
      si (existe tabcon 1) ;
         si (nbob > 1) ;
            ibob = 1 ;
            contot = tabcon.ibob ;
            repeter bbob2 (nbob-1) ;
               ibob = ibob + 1 ;
               angln = (ibob-1)*360./nbob ;
               tabcon.ibob = tabcon.1 tour angln o1 o2 ;
               contot = contot et tabcon.ibob ;
            fin bbob2 ;
         finsi ;
      finsi ;
      (tab2.cont).igeo1 = tabcon ;
   sinon ;
      (tab2.cont).igeo1 = 0 ;
   finsi ;
fin bogeo1 ;
finsi ;
sauter 1 ligne ;
mess ' *** Fin normale de la procedure TORO ***' ;
sauter 1 ligne ;
finproc tabchb tab2 ;
**** TOTAL
****************************************************
******   PROCEDURE TOTAL  ******
*-------------------------------------------------
DEBPROC TOTAL CH1*CHPOINT GEO*MAILLAGE COMP1*MOT ;
CH2 = REDU CH1 GEO ;
CHTOT = RESU CH2 ;
P1 = (EXTR CHTOT MAIL) POIN 1 ;
*MESS 'RESULTANTE DE LA COMPOSANTE  ' COMP1   ;
TOT1 = EXTR CHTOT COMP1 P1 ;
*LIST TOT1 ;
FINPROC TOT1 ;
*-------------------------------------------------
**** @TPERM
'DEBPROC' @TPERM TAB1*'TABLE   '                          ;
SI ( TAB1.PERMANENT )            ;

 MESS '>>>>> 4.10 >>>>>>'                    ;

 COTETF1 = TAB1.C_COTETF1                                   ;
 SITETF1 = TAB1.C_SITETF1                                 ;
 COTETR1 = TAB1.C_COTETR1                                    ;
 SITETR1 = TAB1.C_SITETR1                                    ;
 COTETC1 = TAB1.C_COTETC1                                     ;
 SITETC1 = TAB1.C_SITETC1                                    ;
 TAC2 = TABLE;
 TAB1.I_FPAT1 = TABLE;
 TAB1.FLUX_CRITIQUE = TABLE;
 TAB1.EV_FLUX_CONV = TABLE;
 TAB1.EV_FLUX_RAYO = TABLE;
 TAB1.FLJB_CRI_TONG = TABLE;
 TAB1.RESUTHER = TABLE;
 TAB1.RESUTHER.COEFECHANGE = TABLE;
 TAB1.RESUTHER.VALEUR_TETA = TABLE;
 TAB1.RESUTHER.COEFRAYONNE = TABLE;
 TAB1.RESUTHER.CONDUCMAT = TABLE;
*
*======== DEBUT BOUCLE : DIFFERENTES VALEURS DE FLUX INCIDENT
*
 I_11   = 0;
 REPETER BOCA ( DIME TAB1.LIS_FLUX );
   I_11   = I_11 + 1;
   TAB1.'ITER'= I_11;
*********** cas LAMBDAQ VPAT1  =  exp*sinus
*********** cas LAMBDAQ SOM1   =  somme ( exp*sinus)
*********** cas LAMBDAQ FACFM1 =  SOM1 / largeur (v. moyenne du profil)
*********** cas LAMBDAQ FLU1   =  FACFM1 *  VFLUXIMPOSE ( =PHI0)
*********** cas LAMBDAQ VFPAT1  =  exp*sinus*phi0
* SOM1 = somme de l'integrale de forme
* FACFM1 cette designation vient de FACTEUR de FORME 1
* ces valeurs proviennent de CFLUXX

   SAUTER 1 LIGNE ;
   MESS '---------------------------------------';
   MESS ' Step number ' I_11 ' : Heat flux [MW/m2] '
    ((EXTR TAB1.LIS_FLUX I_11)/1.E6);
   MESS ' '                                          ;

* 'TRAC_GRAPHE' indice pour ne tracer les graphes qu'a l'iteration 1

SI (EGA I_11 1)                         ;
 TAB1.'TRAC_GRAPHE' = VRAI              ;
SINON                                   ;
 TAB1.'TRAC_GRAPHE' = FAUX              ;
FINSI                                   ;


FLU1           = EXTR TAB1.'LIS_FLUMOYEN' I_11;
PUI1           = EXTR TAB1.'LIS_PUI1' I_11;
TAB1.V_FLUMOY1 = EXTR TAB1.'LIS_FLUMOYEN' I_11;
*jsFLU1           = TAB1.'FLU1'.I_11;
*jsPUI1           = TAB1.'PUI1'.I_11;
*jsTAB1.V_FLUMOY1 = TAB1.'FLU1'.I_11;
VFPAT1         = TAB1.'VFPAT1'.I_11;
MESS '>@TPERM> LHEATED POWER' TAB1.L_HEATED PUI1;
 @CALOR TAB1  PUI1                           ;
*js 15/6/95T_LOCAL  = TAB1.'T_LOCAL'                          ;
*
*--- CARACT. EAU A TMOY non a t_local
*
*--- AUTRE METHODE DE CALCUL DE H CONVECTION
*
   SI ( NON ( EXISTE  TAB1  PFIXTONB ) )   ;
     TAB1 . PFIXTONB = FAUX                 ;
   FINSI                                   ;
*
*--- CALCUL DU COEFFICIENT D'ECHANGE
*
    @CALHCON TAB1  ;
    TAB1.'EV_FLUX_CONV'.I_11 = TAB1.EVOFT1   ;
*
*--- CALCUL DU FLUX CRITIQUE
*
@FLUCRIT  TAB1                             ;
TAB1.'FLUX_CRITIQUE'.I_11 = TAB1.L_QCHFW   ;
*
*---- modif Jean BOSCARY 05 10 94
*     faire apparaitre la vraie valeur de TONG75
*     i.e. QCRI1 non multiplie par 1.67
  SI ( NON ( EXISTE TAB1 M_TONGJB ) )             ;
     TAB1.M_TONGJB = FAUX                           ;
  FINSI                                           ;
  SI TAB1.M_TONGJB  ;
     QCRI2 HOU1 TOU1 DTSUB1 XOU1 = TONG75JB TAB1 ;
     TAB1.'FLJB_CRI_TONG'.I_11 =  QCRI2  ;
   FINSI ;
*
*
*--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
*
   ERAYON1  = @CALHRAY   TAB1   ;
   TAB1.'EV_FLUX_RAYO'.I_11 = TAB1.EVORAYT1   ;
*
   MESS ' MAXI MINI VALEURS CALCULEES DU FLUX RENTRANT '
        ( MAXI VFPAT1 ) ( MINI VFPAT1 );
   FPAT1 =      FLUX  (TAB1 . 'MODELF') VFPAT1   ;
   @TRFLI   VFPAT1  FPAT1  TAB1                  ;
*---           INIT DES TABLES
*---(DONNEES A ENVOYER DANS PROCEDUR TRANSIT1)
*
   SI ( EXISTE TAB1 TEMPERATURE )         ;
     MENAGE                                ;
   FINSI                                  ;
  SI ( TAB1.OLD )                  ;
   TAB1.'SOUSTYPE'   = THERMIQUE          ;
   SI ( EXISTE TAB1 LFLUX_CONV )           ;
     TAB1.'MAILLAGV'   =   TAB1.LFLUX_CONV    ;
     TAB1.'CONVECTION' =   IPOL TAB1.'T_LOCAL'
                 ( EXTR TAB1.ECONVEC1 'TEMPERATURE' )
                 ( EXTR TAB1.ECONVEC1 'CONVECTION' )    ;
     TAB1.'EVOCONV'    =   TAB1.ECONVEC1       ;
   FINSI                                    ;
   SI ( EXISTE TAB1 LFLUX_RAYO )           ;
     TAB1.'MAILLAGR'   =   TAB1.LFLUX_RAYO       ;
     TAB1.'HRAYONNE' =   IPOL (TAB1.TEMP_RAYO)
                        ( EXTR ERAYON1 'TEMPERATURE' )
                        ( EXTR ERAYON1 'COEFFICIENT ECHANGE' ) ;
     TAB1.'TETR'       =   TAB1.TEMP_RAYO             ;
     TAB1.'EVOCONR'    =   ERAYON1            ;
   FINSI                                      ;
   FPAT2 = FPAT1                              ;
   SI ( EXISTE TAB1 V_SOURCE )                  ;
     FPAT2 = FPAT1 ET TAB1.'FSOU1'   ;
   FINSI                             ;
   FPAT3 = FPAT2                              ;
   SI ( EXISTE TAB1 'FLUX_IMP' )                  ;
     FPAT3 = FPAT2 ET TAB1.'FLUX_IMP'   ;
   FINSI                             ;
   TAB1.'FLUX'       =   FPAT3              ;

*   TEMPS                                    ;
*
*--- APPEL PROCED. TRANSIT1
*--- RESOL PB THERMIQUE NONLIN
*
   TAB1.'TETA' = TAB1.'T_LOCAL';
   @TRANS10   TAB1;
   TAB1.I_11 = TAB1.TEMPERATURE;
   TAB1.I_FPAT1.I_11 = FPAT1;
   TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE;
   TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.VALEUR_TETA;
   TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFRAYONNE;
   TAB1.RESUTHER.CONDUCMAT.I_11 = TAB1.CONDUCMAT;
  SINON;
   TAB1.'SOUSTYPE'   = THERMIQUE          ;
   SI( NON (EXISTE TAB1 TEMPERATURE) );
    TAB1.'INSTANT(0)' = MANU CHPO STOT1 1 'T' TAB1.'T_LOCAL';
   SINON;
    TAB1.'INSTANT(0)' = TAB1.TEMPERATURE;
   FINSI;
   TAB1.CONVECTION          = TABLE;
   TAB1.CONVECTION.TABCONV1 = TABLE;
   TAB1.CONVECTION.TABTE1   = TABLE;
   MCONV1 = MODL TAB1.LFLUX_CONV thermique CONVECTION;
   MCONV2 = MODL TAB1.LFLUX_RAYO thermique CONVECTION;
   TAB1.CONVECTION.TABCONV1.MCONV1 = TAB1.ECONV    ;
   TAB1.CONVECTION.TABTE1.MCONV1 = TAB1.'T_LOCAL'  ;
   TAB1.CONVECTION.TABCONV1.MCONV2 = ERAYON1       ;
   TAB1.CONVECTION.TABTE1.MCONV2 = TAB1.'TEMP_RAYO' ;
   FPAT2 = FPAT1                            ;
   SI ( EXISTE TAB1 V_SOURCE )              ;
     FPAT2 = FPAT1 ET TAB1.'FSOU1'            ;
   FINSI                                    ;
   TAB1.'FLUX'       =   FPAT2              ;
   TEMPS;
   TRANSIT1 TAB1;
   TEMPS;
   TAB1.RESUTHER.COEFECHANGE.I_11 = TAB1.COEFECHANGE.MCONV1      ;
   TAB1.RESUTHER.VALEUR_TETA.I_11 = TAB1.CONVECTION.TABTE1.MCONV1;
*  TAB1.RESUTHER.VALEUR_TETA.I_11 =    TAB1.VALEUR_TETA.MCONV1   ;
   TAB1.RESUTHER.COEFRAYONNE.I_11 = TAB1.COEFECHANGE.MCONV2;
   TAB1.RESUTHER.CONDUCMAT.I_11   = TAB1.CONDUCMAT         ;

  FINSI;
 FIN BOCA;
FINSI;
*
*
* FIN DU PERMANENT
*
FINPROC                              ;
*
*----------Fin de la procedure @TPERM
*--------------------------------------------------------------------

**** @TRASCH
DEBPROC @TRASCH    M1/MOT
                  OE1/POINT
                  MO1*MMODEL
                 CHA1*MCHAML
                  MA1*MAILLAGE
                  MA2*MAILLAGE
                  CT1*MAILLAGE    ;

*
* !!! R. MITTEAU !!! attention, procedure standard
*
* un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
* pour les mises a jour
*

 CHA2 = REDU CHA1 MO1 ;
 CH1  = CHAN CHPO MO1 CHA2 ;
* CH2  = CHAN 'ATTRIBUT' CH1  'NATURE'  'DISCRET'  ;
 CHA2 = REDU CHA1 MO1 ;
 CO1 = EXTR (EXTR CH1 'COMP') 1 ;
 V1 = ((MINI CH1) + (MAXI CH1))  * .5 ;
 SI (EGA (NBEL MA1) (NBEL MA2));
  CHT = CH1 ;
 SINON ;
  MAE  = (CHAN POI1 MA1) DIFF (CHAN POI1 MA2) ;
  CHE  = MANU CHPO MAE 1 CO1 V1 ;
*  CHE2 =  CHAN 'ATTRIBUT' CHE  'NATURE'  'DISCRET'  ;
  CHT = @ET CH1 CHE ;
 FINSI ;
 SI (NON (EXISTE M1)) ;
  M1 = TEXT '    ';
 FINSI ;
 SI (NON ( EXISTE OE1)) ;
  OE1 = TEXT '    ' ;
 FINSI ;
 TRAC M1 OE1 CHT MA2 CT1 ;
FINPROC ;
**** @TRCPLAS
DEBPROC @TRCPLAS TAB1*TABLE MO_1*MMODEL I__1*ENTIER ;
MESS '---------------------------------> Entree dans @TRCPLAS ';
      P_T1 = PROG  20. 100. 200. 300. 400. 500. 600. 700. 800. 900. ;
*      P_T1 = PROG  20. 100. 200. 300. 400. 500. 600.  ;
      EPSB = 0.05                                                   ;
      I1_1 = 0                                                      ;
      TITRE TAB1.NOM_MAT.I__1 'CINEMATIC PLASTIFICATION CURVES'       ;
      T_AC1 = TABLE                                                  ;
      LIS_1 = MOTS CROI TRIA PLUS LOSA CARR TRIB ETOI TRIB CARR LOSA;
      REPETER BOCPLAS1 ( DIME P_T1 )                                ;
       I1_1 =  I1_1 + 1                                             ;
       T_1 = EXTRAIRE    P_T1   I1_1                                ;
       EE_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'YOUN'                   ;
       YY_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'SIGY'                   ;
       HH_1 = @IPOE T_1 TAB1.'TETMAT'.MO_1.'H'                      ;
       EPSY = YY_1 / EE_1                                           ;
       S_B  = YY_1 + ((EPSB - EPSY)* HH_1)                          ;
       P_EPS1 = PROG 0. EPSY EPSB                                   ;
       P_SIG1 = PROG 0. YY_1 S_B                                    ;
       EV_1 =  EVOL MANU '1EPSILON' P_EPS1 '1SIGMA' P_SIG1          ;
       SI (EGA I1_1 1)                                              ;
        EV_PL1 =  EV_1                                              ;
       SINON                                                        ;
        EV_PL1 = EV_PL1 ET EV_1                                     ;
       FINSI                                                        ;
       MARQ1 = EXTR I1_1 LIS_1                                      ;
       T_AC1.I1_1 = 'CHAIN' ' MARQ ' MARQ1 ' TITR ' T_1             ;
      FIN BOCPLAS1                                                  ;
      DESS EV_PL1 LEGE XBOR 0. 0.003  MIMA DATE T_AC1             ;
      DESS EV_PL1 LEGE XBOR 0. 0.04   MIMA DATE T_AC1              ;
MESS '---------------------------------> Sortie  de  @TRCPLAS ';
FINPROC    ;
**** @TRFLI
DEBPROC @TRFLI  VFPAT1*CHPOINT FPAT1*CHPOINT TAB1*TABLE ;
*
************************************************************************
* @TRFLI procedure de trace du flux incident 2D et 3D                  *
*          VECFLUI  vecteur representant le flux incident              *
*          VECFLUII vecteur representant le flux incident integre EF   *
* Reecriture et rajout de la visu 3D : Alain MOAL (aout 1995)          *
************************************************************************
*
*------------------ VARIABLES D'ENTREE
COSDIR1 = TAB1.C_COTETF1  ;
COSDIR2 = TAB1.C_SITETF1  ;
COSDIR3 = TAB1.C_COS3F1   ;
IHYPVAP = TAB1.HYPERVAP   ;
DH0     = TAB1.DH         ;
MAXSOFL = TAB1.MAX_SOFL   ;
DMAQ0   = TAB1.D_MAQUETTE ;
CONT0   = TAB1.'M_IL_CONTOUR' ;
ITRACFI = TAB1.L_TRAC_FLUXI   ;
NIVEAU1 =   TAB1.'NIVEAU' ;
SI (NIVEAU1 >EG 4) ;
 MESS '-----------------------------------> calling @TRFLI ';
FINSI  ;
SI (NIVEAU1 >EG 3) ;
 MESS '> @TRFLI > IHYPVAP ';LIST IHYPVAP ;
 MESS '> @TRFLI > DH0 ' DH0 ;
 MESS '> @TRFLI > MAXSOFL ' MAXSOFL ;
 MESS '> @TRFLI > DMAQ0 ' DMAQ0 ;
 MESS '> @TRFLI > NIVEAU1 ' NIVEAU1 ;
 TITR '> @TRFLI >  CONT0'  ; TRAC CONT0 NCLK ;
 MESS '> @TRFLI > ITRACFI ';LIST ITRACFI ;
FINSI                                                         ;
SI (EGA (VALEUR DIME) 3) ;
   LIG0 = TAB1.LFLUX_EXTE_DESS ;
   OEIL0 = TAB1.VIEW_P   ;
FINSI ;
*--------------------------------------
*
*---- facteurs d'amplification pour la visualisation des vecteurs

SI IHYPVAP ;
   AMPLV1 = DH0 / (2. * MAXSOFL) ;
SINON ;
   AMPLV1 = DMAQ0 / (2. * MAXSOFL) ;
FINSI ;
AMPLP1 = AMPLV1 * 1.E5  ;
*
*---- visualisations en 2D
*
SI (EGA (VALEUR DIME) 2) ;
*  ---- CONT0 est une ligne
   CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
   CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
   CHPT = @ET CHPX CHPY  ;
   VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
*
   CHPX = EXCO Q (FPAT1 * COSDIR1) UX  ;
   CHPY = EXCO Q (FPAT1 * COSDIR2) UY  ;
   CHPT = @ET CHPX CHPY  ;

   VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
*
   SI ITRACFI ;
      TITRE ' @TRFLI : INCIDENT FLUX ' ;
      TRAC VECFLUI CONT0 ;
      TITRE ' @TRFLI : INTEGRATED FLUX '  ;
      TRAC VECFLUII CONT0 ;
   FINSI;
FINSI ;
*
*---- visualisations en 3D
*
SI (EGA (VALEUR DIME) 3) ;
*  ---- CONT0 est une surface, LIG0 est une ligne
   CHPX = EXCO SCAL (VFPAT1 * COSDIR1) UX ;
   CHPY = EXCO SCAL (VFPAT1 * COSDIR2) UY ;
   CHPZ = EXCO SCAL (VFPAT1 * COSDIR3) UZ ;
   CHPT = @ET (@ET CHPX CHPY) CHPZ  ;
   VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
*
   CHPX = EXCO Q (FPAT1 * COSDIR1) UX  ;
   CHPY = EXCO Q (FPAT1 * COSDIR2) UY  ;
   CHPZ = EXCO Q (FPAT1 * COSDIR3) UZ ;
   CHPT = @ET (@ET CHPX CHPY) CHPZ  ;
   VECFLUII = @VECADA CHPT (-1. * AMPLP1) 'ROUGE' ;
*
   SI ITRACFI ;
      TITRE ' @TRFLI : INCIDENT FLUX ' ;
      TRAC 'CACH' OEIL0 VECFLUI CONT0 ;
      TITRE ' @TRFLI : INTEGRATED FLUX '  ;
      TRAC 'CACH' OEIL0 VECFLUII CONT0 ;
   FINSI;
*
*  ---- Trace du flux incident le long d'une ligne
*  ---- en fonction de l'abscisse curviligne
   TITRE ' @TRFLI : INCIDENT FLUX' ;
   FLUXI = NOMC SCAL VFPAT1 ;
   DESSIN (EVOL JAUN CHPO FLUXI SCAL LIG0) MIMA ;
FINSI ;
*
*------------------ VARIABLES DE SORTIE
TAB1.V_VEC11 = VECFLUII  ;
TAB1.V_VEC22 = VECFLUI   ;
*--------------------------------------
*
SI (NIVEAU1 >EG 4) ;
 MESS '-----------------------------------> exiting @TRFLI ';
FINSI ;
FINPROC ;

**** @TTRACG
debproc @ttracg poin1/point
                text1/texte
                text2/texte
                text3/texte
                 geo1*maillage
                 str1*maillage        ;

v1 = vale dime ;

str2 = str1 coul blan ;
geo2 = geo1 coul roug ;

ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;

dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
dcar2 = dcar1 / 10000.  ;
dcar3 = dcar2 * (2.**.5)  ;

* dcar1 est la dimension caracteristique de geo1


si (ega v1 2) ;
 geo3 = geo2 plus (dcar2 dcar3) ;
sinon ;
 geo3 = geo2 plus (dcar2 dcar3 0.);
finsi ;

*1texttit = chain geo1 'en rouge et ' geo2 'en blan' ;
*titr 1texttit


si (exis poin1) ;
 poin2 = poin1;
sinon ;
 poin2 = text '  ';
finsi ;

si (exis text3) ;
 trac poin2 text1 text2 text3 (geo3 et str2) ;
sinon ;
  si (exis text2 ) ;
  trac poin2 text1 text2  (geo3 et str2);
 sinon ;
  si (exis text1 ) ;
   trac poin2 text1 (geo3 et str2) ;
  sinon ;
    trac poin2 (str2 et geo3 );
  finsi ;
 finsi ;
finsi ;





finproc ;




**** @TTRACP
debproc @ttracp text1/text
                text2/text
                text3/text
                  pp1*point
                 geo1*maillage        ;

v1 = vale dime ;

geo2 = geo1 coul bleu ;
ld1 = (maxi (coor 1 geo1)) - (mini (coor 1 geo1)) ;
ld2 = (maxi (coor 2 geo1)) - (mini (coor 2 geo1)) ;
ld3 = (maxi (coor 3 geo1)) - (mini (coor 3 geo1)) ;

dcar1 = ((ld1 * ld1) + (ld2 * ld2) + (ld3 * ld3)) ** .5 ;
dcar2 = dcar1 / 50.  ;
dcar3 = -1. * dcar2  ;

* dcar1 est la dimension caracteristique de geo1


si (ega v1 2) ;
 pp2 = pp1 plus (dcar2 dcar2);
 pp3 = pp1 plus (dcar3 dcar3);
 pp4 = pp1 plus (dcar2 dcar3);
 pp5 = pp1 plus (dcar3 dcar2);
 croix1 = (pp2 d 1 pp3) et (pp4 d 1 pp5);
sinon ;
 pp2 = pp1 plus (dcar2 0. 0.);
 pp3 = pp1 plus (dcar3 0. 0.);
 pp4 = pp1 plus (0. dcar2 0.);
 pp5 = pp1 plus (0. dcar3 0.);
 pp6 = pp1 plus (0. 0. dcar2);
 pp7 = pp1 plus (0. 0. dcar3);
 croix1 = (pp2 d 1 pp3) et
          (pp4 d 1 pp5) et
          (pp6 d 1 pp7) ;
finsi ;

croix2 = croix1 coul roug ;


*1texttit = chain 'point ' pp1 'dans' geo1 ;
*titr 1texttit

si (exis text3) ;
 trac text1 text2 text3 (geo2 et croix2) ;
sinon ;
 si (exis text2 ) ;
  trac text1 text2 (geo2 et croix2) ;
 sinon ;
  si (exis text1 ) ;
   trac  text1 (geo2 et croix2) ;
  sinon ;
    trac  (geo2 et croix2) ;
  finsi ;
 finsi ;
finsi ;





finproc ;




**** @TTRANS
'DEBPROC' @TTRANS TAB1*'TABLE   '                      ;
** on regarde si il y a un transitoire
SI  ( NON ( EXISTE TAB1  TRANSITOIRE ))   ;
  TAB1.TRANSITOIRE = FAUX              ;
FINSI                              ;
*
SI ( TAB1.TRANSITOIRE    )            ;
  TAB1.ITER = DIME TAB1.LIS_FLUX;
  TAB1.'TRAC_GRAPHE' = VRAI              ;

*********** cas LAMBDAQ VPAT1  =  exp*sinus
*********** cas LAMBDAQ SOM1   =  somme ( exp*sinus)
*********** cas LAMBDAQ SOM3   =  SOM1 * PHIZERO
*********** cas LAMBDAQ FACFM1 =  SOM1 / largeur (v. moyenne du profil)
*********** cas LAMBDAQ FLU1   =  FACFM1 *  VFLUXIMPOSE
*********** cas LAMBDAQ VFPAT1 =  exp*sinus*phi0
*********** cas LAMBDAQ FLU1   =  FACFM1 *  VFLUXIMPOSE
*********** cas LAMBDAQ PHIZERO = VFLUXIMPOSE

*js  FLU1 = TAB1.'FLU1'.(DIME TAB1.LIS_FLUX);
*js  PUI1 = TAB1.'PUI1'.(DIME TAB1.LIS_FLUX);
  FLU1    = EXTR TAB1.'LIS_FLUMOYEN' 1;
  PUI1    = EXTR TAB1.'LIS_PUI1' 1;

  TAB1.V_FLUMOY1 = FLU1;

  VFPAT1  = TAB1.'VFPAT1'.(DIME TAB1.LIS_FLUX);
  FPAT1 = FLUX TAB1.'MODELF' VFPAT1;
*  SOM2 =  ( MAXI (RESU FPAT1)) ;
*   MESS ' >>>>resu flux element finis '  SOM2                ;
*   MESS ' >>>>valeur prevue           '  TAB1.'V_SOM1';
*  SI ( NON ( TAB1.'V_SOM1' EGA SOM2 ( ABS ( SOM2 * 0.05 )))  )   ;
*   MESS ' >>>>verifiez vos valeurs, desole          '         ;
*   ERREUR 'VALEUR_DU_FLUX_RENTRANT'                          ;
*  FINSI                                                 ;
   @CALOR TAB1 PUI1                        ;
  TIN     =  TAB1 . T_IN                          ;
*  CPF = @IPOE TIN TAB1.ETCPF                           ;
*  EMDOTI  = TAB1.V_EMDOTI                             ;
*  TOUT = TIN + (PUI1 / (EMDOTI * CPF))                ;
*  TAB1.'T_LOCAL' =  TIN + ((TOUT - TIN ) * TAB1.X_LOCAL)         ;
*  TMOY  = (TIN + TOUT) / 2.                                  ;
*  TMOY=  TAB1.'T_MOY'     ;


*
*--- APPEL PROCEDURE CALCUL DE 'H CONVECTION (TRANS)'
*
  SI ( EXISTE  TAB1 PFIXTONB )    ;
    TAB1 . PFIXTONB = VRAI        ;
  SINON                           ;
    TAB1 . PFIXTONB = FAUX        ;
  FINSI                           ;

SI ( NON ( EXISTE TAB1 TETA ))                 ;
 TAB1.'TETA' = TAB1.'T_LOCAL';
* TAB1 . 'TETA' = TIN     ;
* MESS '>@TTRANS> Initial Temperature set to TIN';
FINSI                                                ;
*
*SI( NON (EXISTE TAB1 NO_CONV))    ;
 @FLUCRIT  TAB1           ;
* RM 13.03.1997
 SI (TAB1.COUPE_ECH_A_CHF) ;
  TAB1.FLUCRIT1 = TAB1.CHF;
 FINSI ;
 @CALHCON TAB1            ;
 TAB1.'CONVECTION'   =   TABLE                         ;
 TAB1.'CONVECTION' . 'MAILLAGE'   = TAB1 . LFLUX_CONV        ;
 TAB1.'CONVECTION' . 'EVOCONV'    =
   EVOL MANU 'TEMPERATURE' ( EXTR TAB1.ECONVEC1 'ABSC' )
             'COEFFICIENT ECHANGE' ( EXTR TAB1.ECONVEC1 'ORDO' ) ;
 TAB1.'CONVECTION' . 'TEMP_EXT'   = TAB1.'TETA'          ;
*FINSI                     ;


*
*
*--- APPEL PROCEDURE CALCUL DE 'H RAYONNEMENT'
*
*
  ERAYON1  =  @CALHRAY  TAB1              ;
*

 MOT1 = ' TRANSITOIRE NONLINEAIRE METHODE DUPONT2 '  ;
 TAB1.'SOUSTYPE'     = THERMIQUE            ;


 S_TOT1 =  TAB1.'M_ILLAGE_TOT'     ;
 SI ( NON ( EXISTE  TAB1 'INITIAL(0)'))     ;
  TAB1.'INITIAL(0)'   = MANU CHPO S_TOT1 1 'T' TAB1.'TETA'   ;
  TAB1.'INITIAL(1)'   = MANU CHPO S_TOT1 1 'T' TAB1.'TETA'  ;
 SINON                                               ;
  SI ( NON ( EXISTE  TAB1 'INITIAL(1)'))     ;
   TAB1.'INITIAL(1)'   =  TAB1.'INITIAL(0)'  ;
  FINSI                                       ;
 FINSI                                       ;
 TAB1.'RAYONNEMEN'                = TABLE                    ;
 TAB1.'RAYONNEMEN' . 'MAILLAGE'   = TAB1 . LFLUX_RAYO        ;
 TAB1.'RAYONNEMEN' . 'EVORAYO'    = ERAYON1   ;
 TAB1.'RAYONNEMEN' . 'TEMP_EXT'   = TAB1 . TEMP_RAYO       ;
 FPAT2 = FPAT1                                         ;
   SI ( EXISTE TAB1 V_SOURCE )                         ;
    FPAT2 = FPAT1 ET TAB1.FSOU1                           ;
   FINSI                                                      ;
 FPAT3 = FPAT2                                              ;
  SI ( EXISTE TAB1 FLUX_IMP )                               ;
    FPAT3 = FPAT2 ET TAB1.FLUX_IMP                           ;
   FINSI                                                      ;
 TAB1.'FLUX'         =  CHAR 'Q' FPAT3
     ( EVOL MANU 'TEMPS' ( TAB1.'PTF1') (TAB1.'PCF1')  )             ;
* RM 11.03.97
 @TRANSI3  TAB1                                                  ;
* TEMPS                                                           ;

FINSI                        ;
FINPROC                              ;
*
*----------Fin de la procedure @TTRANS
*--------------------------------------------------------------------

**** @CVECT
DEBPROC @CVECT XV*CHPOINT YV*CHPOINT ZV*CHPOINT
               MAIL0*MAILLAGE COUL0*MOT AMPLI0/FLOTTANT;
*
**************************************************************
* Procedure de creation d'un objet de type vecteur a partir  *
* des composantes d'un champ de vecteurs.                    *
* Si le facteur d'amplification pour visualiser un champ de  *
* vecteur sur une geometrie n'est pas donne,il est adapte    *
* aux dimensions geometriques du probleme.                   *
*                Alain MOAL (juillet 1995)                   *
**************************************************************
*
XM = COOR 1 MAIL0 ;
YM = COOR 2 MAIL0 ;
SI ((VALEUR DIME) EGA 2) ;
   ZM = XM * 0. ;
SINON ;
   ZM = COOR 3 MAIL0 ;
FINSI ;
*
SI (NON (EXISTE AMPLI0)) ;
*  ---- norme du vecteur
   VECNORM = ((XV * XV) + (YV * YV) + (ZV * ZV))**0.5 ;
*
*  ---- calcul d'une longueur caracteristique du maillage
   LONGCAR1 = ABS ((MAXI XM) - (MINI XM)) ;
   LONGCAR2 = ABS ((MAXI YM) - (MINI YM)) ;
   LONGCAR3 = ABS ((MAXI ZM) - (MINI ZM)) ;
*
   SI ((VALEUR DIME) EGA 2) ;
      LONGCAR = MINI (PROG LONGCAR1 LONGCAR2) ;
   SINON ;
      LONGCAR = MINI (PROG LONGCAR1 LONGCAR2 LONGCAR3) ;
   FINSI ;
*
   AMPLI0 = LONGCAR / (MAXI VECNORM) / 3.;
*AM*   AMPLI0 = LONGCAR / (MAXI VECNORM) ;
*AM*  AMPLI0 = 2. * LONGCAR / (MAXI VECNORM) ;
FINSI ;
*
SI ((VALEUR DIME) EGA 2) ;
   CHV1  = @ET (NOMC UX XV) (NOMC UY YV) ;


*CAST94*   CHV1  = (NOMC UX XV) ET (NOMC UY YV) ;
   VECT1 = VECT CHV1 AMPLI0 UX UY COUL0 ;
SINON ;
   CHV1  = @ET (@ET (NOMC UX XV) (NOMC UY YV)) (NOMC UZ ZV) ;
*CAST94* CHV1  = (NOMC UX XV) ET (NOMC UY YV) ET (NOMC UZ ZV) ;
   VECT1 = VECT CHV1 AMPLI0 UX UY UZ COUL0 ;
FINSI ;
FINPROC VECT1 ;


DEBPROC  @VISRES  TAB1*TABLE ;
*
******************************************************************
* Procedure de visualisation des resultats d'un calcul permanent *
* en 3D.           Alain MOAL (aout-sept 1995)                   *
******************************************************************
*
MESS '---------------------------------> calling @VISRES';
*
ITER = 1 ;
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<MAILLAGE ;
TEMP     = TAB1.TEMPERATURE ;
LIGCONV  = TAB1.LFLUX_CONV_DESS ;
SURFCONV = TAB1.LFLUX_CONV ;
SURFEXTE = TAB1.LFLUX_EXTE ;
TE1      = TAB1.ITER ;
VTETA1   = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
HCONV1   = TAB1.RESUTHER.COEFECHANGE.ITER ;
PROFIL0  = TAB1.V_VPAT1 ;
FLU0     = EXTR TAB1.LIS_FLUX ITER;
MODEL0   = TAB1.MODELF ;
LIG0     = TAB1.LFLUX_EXTE_DESS ;
MAXSOFL  = TAB1.MAX_SOFL   ;
DMAQ0    = TAB1.D_MAQUETTE ;
NX       = TAB1.C_COTETF1  ;
NY       = TAB1.C_SITETF1  ;
NZ       = TAB1.C_COS3F1   ;
VOLMAT1  = TAB1.ZONE_MAT.1 ;
VOLMAT2  = TAB1.ZONE_MAT.2 ;
VOLMAT3  = TAB1.ZONE_MAT.3 ;
ANGINCI  = TAB1.<ANGINCI;
*TEST*VBVN     = TAB1.<VBVN ;
SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
   P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
   P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
   P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
SINON ;
   ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
FINSI ;
SI ((VALEUR DIME) EGA 3) ;
   OEIL0 = TAB1.VIEW_P ;
SINON ;
   ERRE '>>>> @VISRES only works on 3D geometries' ;
FINSI ;
*------------------------------------
*
*---- Table de visualisation
TAB2 = TABLE ;
TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
*
SI ((VALEUR DIME) NEG 3) ;
   ERRE '>>>> @VISRES only works on 3D modelisations';
FINSI ;
*
FLU1 = FLU0 * PROFIL0 ;
*
*---- Trace du flux incident, de la temperature et de l'angle d'incidence
*---- le long d'une ligne en fonction de l'abscisse curviligne
XM = COOR 1 LIG0 ;
LIG2 = CHAN SEG2 LIG0 ;
XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
FLUXI = NOMC SCAL FLU1 ;
TEMP1 = NOMC SCAL TEMP ;
TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
DESSIN EVANGI MIMA ;
*TEST*TITRE ' @VISRES : VBVN ';
*TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
*TEST*DESSIN EVVBVN MIMA ;
*
*---- Trace de l'evolution du flux de convection le long d'une ligne
VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
SI (EGA (TYPE VTETA1) 'CHPOINT ');
   VTETA = EXCO 'T' VTETA1 ;
SINON ;
   VTETA = VTETA1 ;
FINSI ;
HCONV = EXCO 'H' HCONV1 ;
*
*---- flux de convection sur la ligne et temperatures sur la ligne
FLUCONV = HCONV * (VTETA0 - VTETA)  ;
TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
*
*---- temperatures sur la ligne
*TITRE '@VISRES : WALL TEMPERATURE (C)' ;
*DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
*
*---- flux de convection sur la surface de convection
FLUCONV0 = HCONV * (TE1 - VTETA) ;
*
*---- Calcul du facteur de concentration et de la puissance extraite
FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
FLUINT1 = FLUX MODEL0 FLU1 ;
FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
PUI1 = MAXI(RESU FLUINT1) ;
*
*---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
*---- incident et de convection
CHPX = EXCO SCAL (FLU1 * NX) UX ;
CHPY = EXCO SCAL (FLU1 * NY) UY ;
CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
CHPT = @ET (@ET CHPX CHPY) CHPZ ;
AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
*FX = FLU1 * NX;
*FY = FLU1 * NY;
*FZ = FLU1 * NZ;
*VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
TITRE '@VISRES : ISOTHERM IN SECTION' ;
TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
*
*---- Trace des isovaleurs de temperature sans le maillage
TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
SI (EGA (VALEUR ELEM) 'CUB8') ;
   ARET1 = ARETE VOLMAT1 ;
   ARET2 = ARETE VOLMAT2 ;
   ARET3 = ARETE VOLMAT3 ;
SINON ;
   ARET1 = ARETE VOLMAT1 40.;
   ARET2 = ARETE VOLMAT2 40.;
   ARET3 = ARETE VOLMAT3 40.;
FINSI ;
ARET0 = ARET1 ET ARET2 ET ARET3 ;
TRAC CACH OEIL0 7 TEMP MAIL0 ARET0 ;
TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
*
*---- Messages
MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
MESS ' MEAN INCIDENT FLUX (W/m2).............: '  FLUMOY ;
MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
*
MESS '---------------------------------> exiting @VISRES';
FINPROC ;
**** @VDEFAUT
DEBPROC  @VDEFAUT  TAB1*TABLE ;
*
**********************************************************************
* Procedure de preparation de la table TAB1 pour le calcul du profil *
* du depot de puissance par la procedure @TOKAFLU.                   *
* On donne ici les valeurs par defaut et on verifie l'existence de   *
* certains indices importants de la table. Alain MOAL (juillet 1995) *
**********************************************************************
*
MESS '---------------------------------> calling @VDEFAUT ';
SI (NON (EXISTE TAB1 <IMESS)) ;
   TAB1.<IMESS = 1 ;
   MESS 'The level of message on screen is : 1';
FINSI;
SI (NON (EXISTE TAB1 <ITRAC)) ;
   TAB1.<ITRAC = VRAI ;
   MESS 'Drawings are printed on screen';
FINSI;
SI (NON (EXISTE TAB1 <COEFA)) ;
   TAB1.<COEFA = 5.8E-5 ;
   MESS 'The first coefficient of the ripple model is : 5.8E-5';
FINSI;
SI (NON (EXISTE TAB1 <COEFB)) ;
   TAB1.<COEFB = 5.5 ;
   MESS 'The second coefficient of the ripple model is : 5.5';
FINSI;
SI (NON (EXISTE TAB1 <COEFC)) ;
   TAB1.<COEFC = 4.5E-5 ;
   MESS 'The third coefficient of the ripple model is : 4.5E-5';
FINSI;
SI (NON (EXISTE TAB1 <EPS)) ;
   TAB1.<EPS = 1.E-5 ;
   MESS 'The convergence criterium is : 1.E-5';
FINSI;
SI (NON (EXISTE TAB1 <RR)) ;
   TAB1.<RR = 2.20 ;
   MESS 'The large radius of the ripple referential is : 2.20 m';
FINSI;
SI (NON (EXISTE TAB1 <RP)) ;
   MESS 'You must give the value of the large plasma radius';
   ERRE '>>>> TAB1.<RP is missing' ;
FINSI;
SI (NON (EXISTE TAB1 <HP)) ;
   TAB1.<HP = 0. ;
   MESS 'The height of the plasma center is : 0. m';
FINSI;
SI (NON (EXISTE TAB1 <IPLASMA)) ;
   MESS 'You must give the value of the plasma current' ;
   ERRE '>>>> TAB1.<IPLASMA is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <INTENS)) ;
   MESS 'You must give the value of the current in each whorl';
   MESS 'of coils';
   ERRE '>>>> TAB1.<INTENS is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <LAMB)) ;
   MESS 'You must give the value of the asymmetrical factor ';
   MESS 'of the poloidal field';
   ERRE '>>>> TAB1.<LAMB is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <THETA0)) ;
   TAB1.<THETA0 = 0. ;
*AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
FINSI;
*
* RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
*
SI (NON (EXISTE TAB1 <ANGPHI0)) ;
   TAB1.<ANGPHI0 = 0. ;
FINSI;
SI (NON (EXISTE TAB1 <THETAREF)) ;
   TAB1.<THETAREF = -90. ;
   MESS 'The reference angle for lambdaq is : -90. degrees';
FINSI;
SI (NON (EXISTE TAB1 <LAMBQREF)) ;
*AM*   TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
   MESS 'You must give the value of the reference decrease length ';
   ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
   TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE'  ;
   MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
FINSI;
SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
   TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV'  ;
   MESS 'The poloidal magnetic field model is : SHAFRANOV';
FINSI;
SI (NON (EXISTE TAB1 <NBOB)) ;
   TAB1.<NBOB = 18 ;
   MESS 'The number of coils is : 18 ';
FINSI;
SI (NON (EXISTE TAB1 <NSPI)) ;
   TAB1.<NSPI = 2028 ;
   MESS 'The number of whorls in each coil is : 2028 ';
FINSI;

SI ((VALEUR DIME) EGA 2) ;
   SI (NON (EXISTE TAB1 <PLAN)) ;
      MESS 'You must give the kind of 2D section ';
      ERRE '>>>> TAB1.<PLAN is missing ' ;
   FINSI ;
   SI (EGA TAB1.<PLAN 'THECONS') ;
      SI (NON (EXISTE TAB1 <THETA0)) ;
         MESS 'You must give the THETA angle locating';
         MESS 'the part into the tokamak' ;
         ERRE '>>>> TAB1.<THETA0 is missing ' ;
      FINSI ;
      SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
         MESS 'You must give the plasma center ';
         ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
      FINSI ;
   FINSI ;
   SI (EGA TAB1.<PLAN 'PHICONS') ;
      SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
         MESS 'You must give the tokamak center' ;
         ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
      FINSI ;
      SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
         MESS 'You must give a second point on the tokamak axis';
         ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
      FINSI ;
      SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
         MESS 'You must give a reference point on the part';
         ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
      FINSI ;
   FINSI ;
   SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
      TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
   FINSI ;
FINSI;

SI ((VALEUR DIME) EGA 3);
   SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
      MESS 'You must give the tokamak center' ;
      ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
   FINSI ;
   SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
      MESS 'You must give a second point on the tokamak axis';
      ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
   FINSI ;
   SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
      MESS 'You must give a reference point on the part';
      ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
   FINSI ;
FINSI ;

SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
   MESS 'You must give the initial toroidal angle ';
   MESS 'locating the reference point of the part ';
   MESS 'in the tokamak';
   ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
FINSI ;
SI ((VALEUR DIME) EGA 3)     ;
   SI (NON (EXISTE TAB1 VIEW_P)) ;
      TAB1.VIEW_P = -1000. 1000. 1000. ;
   FINSI;
FINSI;
*
*---- norme du champ magnetique toroidal au centre du plasma
* rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
;
BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
*
MESS '---------------------------------> exiting @VDEFAUT ';
FINPROC ;

**** @VDEFAUT
DEBPROC  @VDEFAUT  TAB1*TABLE ;
*
**********************************************************************
* Procedure de preparation de la table TAB1 pour le calcul du profil *
* du depot de puissance par la procedure @TOKAFLU.                   *
* On donne ici les valeurs par defaut et on verifie l'existence de   *
* certains indices importants de la table. Alain MOAL (juillet 1995) *
**********************************************************************
*
MESS '---------------------------------> calling @VDEFAUT ';
SI (NON (EXISTE TAB1 <IMESS)) ;
   TAB1.<IMESS = 1 ;
   MESS 'The level of message on screen is : 1';
FINSI;
SI (NON (EXISTE TAB1 <ITRAC)) ;
   TAB1.<ITRAC = VRAI ;
   MESS 'Drawings are printed on screen';
FINSI;
SI (NON (EXISTE TAB1 <COEFA)) ;
   TAB1.<COEFA = 5.8E-5 ;
   MESS 'The first coefficient of the ripple model is : 5.8E-5';
FINSI;
SI (NON (EXISTE TAB1 <COEFB)) ;
   TAB1.<COEFB = 5.5 ;
   MESS 'The second coefficient of the ripple model is : 5.5';
FINSI;
SI (NON (EXISTE TAB1 <COEFC)) ;
   TAB1.<COEFC = 4.5E-5 ;
   MESS 'The third coefficient of the ripple model is : 4.5E-5';
FINSI;
SI (NON (EXISTE TAB1 <EPS)) ;
   TAB1.<EPS = 1.E-5 ;
   MESS 'The convergence criterium is : 1.E-5';
FINSI;
SI (NON (EXISTE TAB1 <RR)) ;
   TAB1.<RR = 2.20 ;
   MESS 'The large radius of the ripple referential is : 2.20 m';
FINSI;
SI (NON (EXISTE TAB1 <RP)) ;
   MESS 'You must give the value of the large plasma radius';
   ERRE '>>>> TAB1.<RP is missing' ;
FINSI;
SI (NON (EXISTE TAB1 <HP)) ;
   TAB1.<HP = 0. ;
   MESS 'The height of the plasma center is : 0. m';
FINSI;
SI (NON (EXISTE TAB1 <IPLASMA)) ;
   MESS 'You must give the value of the plasma current' ;
   ERRE '>>>> TAB1.<IPLASMA is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <INTENS)) ;
   MESS 'You must give the value of the current in each whorl';
   MESS 'of coils';
   ERRE '>>>> TAB1.<INTENS is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <LAMB)) ;
   MESS 'You must give the value of the asymmetrical factor ';
   MESS 'of the poloidal field';
   ERRE '>>>> TAB1.<LAMB is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <THETA0)) ;
   TAB1.<THETA0 = 0. ;
*AM*MESS 'The THETA angle locating the part into the tokamak is : 0.';
FINSI;
*
* RM attention, ce <ANGPHI0 n a rien a voir avec <ANG_PHI0
*
SI (NON (EXISTE TAB1 <ANGPHI0)) ;
   TAB1.<ANGPHI0 = 0. ;
FINSI;
SI (NON (EXISTE TAB1 <THETAREF)) ;
   TAB1.<THETAREF = -90. ;
   MESS 'The reference angle for lambdaq is : -90. degrees';
FINSI;
SI (NON (EXISTE TAB1 <LAMBQREF)) ;
*AM*   TAB1.<LAMBQREF = 15.4 /((TAB1.<IPLASMA)**0.5) ;
   MESS 'You must give the value of the reference decrease length ';
   ERRE '>>>> TAB1.<LAMBQREF is missing ' ;
FINSI;
SI (NON (EXISTE TAB1 <TYPE_CALCUL)) ;
   TAB1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE'  ;
   MESS 'The option of computation is : AVEC_SHIFT_AVEC_RIPPLE';
FINSI;
SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
   TAB1.<TYPE_DEPOT = MOT 'PARALLELE'  ;
   MESS 'The heat deposition is : PARALLELE';
FINSI;
* RM le 08/12/1998
SI (NON ((EGA TAB1.<TYPE_DEPOT 'PARALLELE') OU
         (EGA TAB1.<TYPE_DEPOT 'PERPENDICULAIRE')));
    ERRE '>>>>@VDEFAUT, DEFINTION OF TAB1.<TYPE_DEPOT';
FINSI ;
SI (NON (EXISTE TAB1 <MODEL_CHAMP)) ;
   TAB1.<MODEL_CHAMP = MOT 'SHAFRANOV'  ;
   MESS 'The poloidal magnetic field model is : SHAFRANOV';
FINSI;
SI (NON (EXISTE TAB1 <NBOB)) ;
   TAB1.<NBOB = 18 ;
   MESS 'The number of coils is : 18 ';
FINSI;
SI (NON (EXISTE TAB1 <NSPI)) ;
   TAB1.<NSPI = 2028 ;
   MESS 'The number of whorls in each coil is : 2028 ';
FINSI;

SI ((VALEUR DIME) EGA 2) ;
   SI (NON (EXISTE TAB1 <PLAN)) ;
      MESS 'You must give the kind of 2D section ';
      ERRE '>>>> TAB1.<PLAN is missing ' ;
   FINSI ;
   SI (EGA TAB1.<PLAN 'THECONS') ;
      SI (NON (EXISTE TAB1 <THETA0)) ;
         MESS 'You must give the THETA angle locating';
         MESS 'the part into the tokamak' ;
         ERRE '>>>> TAB1.<THETA0 is missing ' ;
      FINSI ;
      SI (NON (EXISTE TAB1 CENTRE_PLASMA)) ;
         MESS 'You must give the plasma center ';
         ERRE '>>>> TAB1.CENTRE_PLASMA is missing';
      FINSI ;
   FINSI ;
   SI (EGA TAB1.<PLAN 'PHICONS') ;
      SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
         MESS 'You must give the tokamak center' ;
         ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
      FINSI ;
      SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
         MESS 'You must give a second point on the tokamak axis';
         ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
      FINSI ;
      SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
         MESS 'You must give a reference point on the part';
         ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
      FINSI ;
   FINSI ;
   SI (NON (EXISTE TAB1 LFLUX_EXTE_DESS)) ;
      TAB1.LFLUX_EXTE_DESS = TAB1.LFLUX_EXTE ;
   FINSI ;
FINSI;

SI ((VALEUR DIME) EGA 3);
   SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
      MESS 'You must give the tokamak center' ;
      ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
   FINSI ;
   SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
      MESS 'You must give a second point on the tokamak axis';
      ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
   FINSI ;
   SI (NON (EXISTE TAB1 <POINT_SUR_OBJET)) ;
      MESS 'You must give a reference point on the part';
      ERRE '>>>> TAB1.<POINT_SUR_OBJET is missing';
   FINSI ;
FINSI ;

SI (NON (EXISTE TAB1 <ANG_PHI0)) ;
   MESS 'You must give the initial toroidal angle ';
   MESS 'locating the reference point of the part ';
   MESS 'in the tokamak';
   ERRE '>>>> TAB1.<ANG_PHI0 is missing' ;
FINSI ;
SI ((VALEUR DIME) EGA 3)     ;
   SI (NON (EXISTE TAB1 VIEW_P)) ;
      TAB1.VIEW_P = -1000. 1000. 1000. ;
   FINSI;
FINSI;
*
*---- norme du champ magnetique toroidal au centre du plasma
* rm 24.07.97 BTOR0 = 2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP
;
BTOR0 = -2.E-7 * TAB1.<NBOB * TAB1.<NSPI * TAB1.<INTENS / TAB1.<RP ;
MESS 'The toroidal magnetic field at the plasma center is (T): 'BTOR0;
*
MESS '---------------------------------> exiting @VDEFAUT ';
FINPROC ;

**** @VDEFJET

DEBPROC  @VDEFJET  TAB1*TABLE ;
*
**********************************************************************
* Procedure de preparation de la table TAB1 pour le calcul du profil *
* du depot de puissance par la procedure @CFPFLU.                    *
* On donne ici les valeurs par defaut et on verifie l'existence de   *
* certains indices importants de la table. Alain MOAL (Fevrier 2001) *
**********************************************************************
* Modif :                                                            *
* 08/11/01 (A.MOAL) : test sur TAB1.<PUISSANCE_TOTALE et sur         *
*                     TAB1.<SENS_REMONTEE                            *
* 27/01/04 (A.MOAL) : ajout de TAB1.<ANG_PHI0 = 0 et                 *
*                     TAB1.<POINT_SUR_OBJET pour utiliser les memes  *
*                     procedures que pour @TOKAFLU                   *
**********************************************************************
*
MESS '---------------------------------> calling @VDEFJET ';
SI (NON (EXISTE TAB1 <IMESS)) ;
   TAB1.<IMESS = 1 ;
   MESS 'The level of message on screen is : 1';
FINSI;
SI (NON (EXISTE TAB1 <ITRAC)) ;
   TAB1.<ITRAC = VRAI ;
   MESS 'Drawings are printed on screen';
FINSI;
SI ((VALEUR DIME) EGA 2) ;
   MESS 'Computation in 2 dimensions is not available';
   ERRE '>>>> You must work in 3 dimensions' ;
FINSI;
SI ((VALEUR DIME) EGA 3);
   SI (NON (EXISTE TAB1 <CENTRE_TORE)) ;
      MESS 'The tokamak center is (0. 0. 0.)' ;
      TAB1.<CENTRE_TORE = 0. 0. 0. ;
*      MESS 'You must give the tokamak center' ;
*      ERRE '>>>> TAB1.<CENTRE_TORE is missing' ;
   FINSI ;
   SI (NON (EXISTE TAB1 <POINT_SUR_AXE_TORE)) ;
      MESS 'The vertical axis is defined by the point (0. 0. 1.)';
      TAB1.<POINT_SUR_AXE_TORE = 0. 0. 1. ;
*      MESS 'You must give a second point on the tokamak axis';
*      ERRE '>>>> TAB1.<POINT_SUR_AXE_TORE is missing';
   FINSI ;
*AM*27/01/04
   TAB1.<ANG_PHI0 = 0. ;
   TAB1.<POINT_SUR_OBJET = 1. 0. 0.;
FINSI ;
SI ((VALEUR DIME) EGA 3)     ;
   SI (NON (EXISTE TAB1 VIEW_P)) ;
      TAB1.VIEW_P = -1000. 1000. 1000. ;
   FINSI;
FINSI;
SI (NON (EXISTE TAB1 <TYPE_DEPOT)) ;
   TAB1.<TYPE_DEPOT = VRAI  ;
   MESS 'The heat deposition is : PARALLELE';
FINSI;
SI (NON (EXISTE TAB1 <CALCUL_INCIDENCE)) ;
   TAB1.<CALCUL_INCIDENCE = FAUX ;
FINSI;
SI (NON (EXISTE TAB1 <PUISSANCE_TOTALE)) ;
   MESS 'You must give the total power deposited (MW)';
   ERRE '>>>> TAB1.<PUISSANCE_TOTALE is missing' ;
FINSI;
SI (NON (EXISTE TAB1 <SENS_REMONTEE)) ;
   TAB1.<SENS_REMONTEE = 0 ;
FINSI;
*
MESS '---------------------------------> exiting @VDEFJET ';
FINPROC ;

**** @VECADA
DEBPROC @VECADA <CHP1*CHPOINT  <AMPL1*FLOTTANT <MOT1*MOT;
  V_DIM1 = VALEUR 'DIME' ;
  SI ( V_DIM1 EGA 2)  ;
     >VECT1 = VECTEUR <CHP1  <AMPL1 UX UY <MOT1;
  SINON  ;
     >VECT1 = VECTEUR <CHP1  <AMPL1 UX UY UZ <MOT1 ;
  FINSI ;
FINPROC >VECT1  ;
**** @VECGRAD
DEBPROC @VECGRAD TAB1*TABLE <CHP1*CHPOINT
                <AMPL1*FLOTTANT <MOT1*MOT;
MESS '---------------------------------> entree dans @VECGRAD';
MESS 'ATTENTION PAS ENCORE AU POINT !!!!!!!!!!!!!!!!!!!';
V1 = VALE DIME ;
SI (NON (EGA V1 2)) ;
 MESS 'ERREUR dans lemploi de @VECGRAD...on nest pas en 2D'
 ERRE '@VECGRAD';
FINSI ;
S_TOT1 = TAB1.'M_ILLAGE_TOT';
CON_1  = TAB1.'M_IL_CONTOUR';
IZ = 0     ;
REPE BOU11 ;
 IZ = IZ + 1  ;
 SI ( NON ( EXISTE (TAB1.ZONE_MAT) IZ)) ;
  QUITTER BOU11 ;
 FINSI          ;
 MOD_1 = TAB1.DEF_MO.IZ               ;
 MAI_1 = TAB1.ZONE_MAT.IZ             ;
 CHT_2 = REDU <CHP1 MAI_1               ;
 GR_1  = CHAN NOEUD (GRAD MOD_1 CHT_2) MOD_1;
 GR_1  = CHAN CHPO GR_1 MOD_1;
 VK_1  = @EVMAT TAB1.NOM_MAT.IZ 'CONDUCTIVITE' CHT_2 ;
 VK_1  = NOMC  'SCAL' (-1. * VK_1 ) ;
 FL_1  = VK_1 * GR_1;

 CHN1 = MANU CHPO MAI_1 1 'SCAL' 1. ;


 SI ( IZ EGA 1 )                     ;
  FL_T = FL_1                        ;
  CHN2 = CHN1 ;
LIST ((MAXI CHN2 ) - (MINI CHN2 ));
 SINON                               ;
  FL_T = FL_T ET FL_1                        ;
  CHN2 = CHN2 ET CHN1 ;
LIST ((MAXI CHN2 ) - (MINI CHN2 ));
 FINSI                                    ;
  C_OLD = CC_1       ;
FIN BOU11      ;
FL_T =   FL_T  / CHN2;
>VECT1 = VECTEUR FL_T  <AMPL1 T,X T,Y <MOT1;


MESS '---------------------------------> sortie  de  @VECGRAD';


FINPROC >VECT1;
**** @VERANG

DEBPROC @VERANG TAB1*TABLE ;
*
********************************************************
* Procedure de creation de la ligne de reference (flux *
* normalise dans un fichier issu de PROTEUS) pour      *
* verification des angles d'incidences.                *
*                Alain MOAL (Mars 2001)                *
********************************************************
*
MESS '---------------------------------> calling @VERANG';
*
*--------------- VARIABLES D'ENTREE :
NOM0 = TAB1.<NOM_FICHIER_F      ;
*------------------------------------
*
OPTI ACQUERIR NOM0 ;
*---- lecture du nombre de lignes a lire dans le fichier
ACQU I*ENTIER ;
MESS '@VERANG IS READING 'I' LINES IN FILE 'NOM0 ;
*
*---- ligne de titre
ACQU MOT1*MOT MOT2*MOT MOT3*MOT MOT4*MOT MOT5*MOT
     MOT6*MOT MOT7*MOT ;
*
ACQU R0*FLOTTANT Z0*FLOTTANT DPSI1*FLOTTANT
     AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT
     Q1*FLOTTANT ;
*
*---- creation du premier point
P0 = R0 0. Z0 ;
*
*
ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT
     AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT
     Q1*FLOTTANT ;
P1 = R1 0. Z1 ;
*
LIG1 = P0 D 1 P1 ;
*
*---- boucle sur les I-1 autres lignes du tableau
REPETER BOUC1 (I-2) ;
   ACQU R1*FLOTTANT Z1*FLOTTANT DPSI1*FLOTTANT
        AEFF10*FLOTTANT DDPSI1*FLOTTANT PLEG1*FLOTTANT
        Q1*FLOTTANT ;
   P1 = R1 0. Z1 ;
   LIG1 = LIG1 D 1 P1 ;
FIN BOUC1 ;
*
*---- calcul des angles d'incidences
TAB1.<MAILLAGE_B = LIG1 ;
BR BZ BPHI = @MAGNB TAB1 ;
*
PHI = ATG (COOR 2 TAB1.<MAILLAGE_B) (COOR 1 TAB1.<MAILLAGE_B) ;
*AM*11/09/01*BX = BR * (COS PHI) + (BPHI * (SIN PHI));
*AM*11/09/01*BY = BR * (SIN PHI) - (BPHI * (COS PHI));
BX = BR * (COS PHI) - (BPHI * (SIN PHI));
BY = BR * (SIN PHI) + (BPHI * (COS PHI));
*
*---- Calcul des cosinus
B_NORM = ((BX*BX) + (BY*BY) + (BZ*BZ))**0.5 ;
COSR0 = BR / B_NORM ;
COSZ0 = BZ / B_NORM ;
COSP0 = BPHI / B_NORM ;
*
TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND r AXIS' ;
EVOL1 = EVOL ROUG CHPO COSR0 LIG1 ;
DESS EVOL1 ;
LIST EVOL1 ;
*
TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND z AXIS' ;
EVOL1 = EVOL ROUG CHPO COSZ0 LIG1 ;
DESS EVOL1 ;
LIST EVOL1 ;
*
TITRE '@VERANG : COSINUS OF THE ANGLE BETWEEN b AND phi AXIS' ;
EVOL1 = EVOL ROUG CHPO COSP0 LIG1 ;
DESS EVOL1 ;
LIST EVOL1 ;
*
MESS '---------------------------------> exiting @VERANG';
*
FINPROC ;

DEBPROC  @VISIN  TAB1*TABLE ;
*
*****************************************************************
* Procedure de visualisation de l'objet modelise positionne par *
* rapport au plasma. Cette procedure ne fonctionne qu'en 3D.    *
*                      Alain MOAL (Aout 1995)                   *
*****************************************************************
*
OPTI ECHO 0 ;
MESS '---------------------------------> calling @VISIN';
*
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<MAILLAGE       ;
CP       = TAB1.'CENTRE_PLASMA' ;
PT       = TAB1.'PT_TGPLASMA'   ;
THETA0   = TAB1.<THETA0         ;
RHO0     = TAB1.<RHO0           ;
RP       = TAB1.<RP             ;
*------------------------------------
*
SI (NON ((VALEUR DIME) EGA 3)) ;
   ERRE '>>>> @VISIN only works on 3D geometries' ;
FINSI ;
*
*---- creation d'une nouvelle geometrie MAIL0V dans le repere local
*----      - l'origine O est placee au point tangent au plasma
*----      - l'axe OY est dirige vers le centre du plasma
*
VECT0 = CP MOINS PT ;
*
*---- verification de la valeur du petit rayon du plasma
RHO0 = NORM VECT0 ;
*---- verification que cette valeur est la meme que celle de TAB1.<RHO0
SI (EXISTE TAB1 <RHO0) ;
   SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
      MESS '>>>> The computed value of the plasma radius is not';
      MESS '>>>> the same as the given one in TAB1.<RHO0.';
      MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
      ERRE ' >>>> ERROR in @VICIN' ;
   FINSI ;
FINSI ;
*
VX = COOR 1 VECT0  ;
VY = COOR 2 VECT0  ;
VZ = COOR 3 VECT0  ;
P1 = 0. 0. 0. ;
P2 = 0. 0. 1. ;
VTRANS = PT MOINS P1 ;
SI (VY EGA 0.)    ;
   SI (VX EGA 0.) ;
      ANG1 = 0.   ;
   FINSI          ;
   SI (VX > 0.)   ;
      ANG1 = 90.  ;
   FINSI          ;
   SI (VX < 0.)   ;
      ANG1 = -90. ;
   FINSI          ;
SINON             ;
   ANG1 = ATG VX VY ;
FINSI             ;
*
MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
*
VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
VZ1 = VZ ;
*
SI (VY1 EGA 0.)    ;
   SI (VZ1 EGA 0.) ;
      ANG2 = 0.    ;
   FINSI           ;
   SI (VZ1 > 0.)   ;
      ANG2 = -90.  ;
   FINSI           ;
   SI (VZ1 < 0.)   ;
      ANG2 = 90.   ;
   FINSI           ;
SINON              ;
   ANG2 = -1.* (ATG VZ1 VY1) ;
FINSI              ;
*
P1 = 0. 0. 0. ;
P2 = 1. 0. 0. ;
MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
*
*---- creation des axes du repere local :
*----      - l'origine O est placee au point tangent au plasma
*----      - l'axe OY est dirige vers le centre du plasma
*---- avec OX en bleu, OY en blanc, OZ en rouge
DENS 0.1 ;
OB1 = 0. 0. 0. ;
OB2 = .1 0. 0. ;
OB3 = 0. .1 0. ;
OB4 = 0. 0. .1 ;
LX = (D OB2 OB1) COUL BLEU ;
LY = (D OB3 OB1) COUL BLAN ;
LZ = (D OB4 OB1) COUL ROUG ;
MAIL0V = MAIL0V ET LX ET LY ET LZ  ;
*TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
*
* ---- visualisation de la structure etudiee dans le tore
ABS1 = RHO0 * (SIN THETA0) * -1.  ;
ABS2 = RHO0 * (COS THETA0) + RHO0 ;
ABS3 = RP * (COS THETA0) + RHO0   ;
ABS4 = RP * (SIN THETA0)          ;
ABS5 = RHO0 * (SIN THETA0)        ;
ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
ABS7 = RHO0 * (SIN(70.+THETA0)) ;
ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
*
CPLASMA = 0.   RHO0          0.   ;
CTORE   = 0.   ABS2       ABS4    ;
CAUX1   = 0.   ABS6       ABS7    ;
CAUX2   = 0.   ABS8       ABS9    ;
CAUX3   = 0.   ABS2       ABS5    ;
*
LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET
          (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
*TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
*
*  ----
MENAGE ;
ANGROT1 = -1.* THETA0 ;
VECT1 = 0.   (-1.*RHO0*(COS THETA0) - RP)
                (RHO0*(SIN THETA0))  ;
MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
CP1 = RP  0. 0. ;
CP2 = 0.  0. 1. ;
LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
MAIL0V = MAIL0V ET LIGTORE ;
MENAGE ;
*
*---- multiplication des aiguilles sur le plancher
*aig*   MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
*aig*              ET (MAIL0V TOUR 1.4 OB1 OB4)
*aig*              ET (MAIL0V TOUR 2.1 OB1 OB4)
*aig*              ET (MAIL0V TOUR 2.8 OB1 OB4) ;
*aig*   MENAGE ;
*aig*   MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
*aig*   MENAGE ;
*
TITRE 'POSITION OF THE MODELISED STRUCTURE IN THE TORE' ;
TRACE (0. -1000.  0.) FACE CACH MAIL0V ;
MESS '---------------------------------> exiting @VISIN';
FINPROC ;
DEBPROC  @VISIN  TAB1*TABLE ;
*
*****************************************************************
* Procedure de visualisation de l'objet modelise positionne par *
* rapport au plasma. Cette procedure ne fonctionne qu'en 3D.    *
*                      Alain MOAL (Aout 1995)                   *
*****************************************************************
*
OPTI ECHO 0 ;
MESS '---------------------------------> calling @VISIN';
*
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<MAILLAGE       ;
CP       = TAB1.'CENTRE_PLASMA' ;
PT       = TAB1.'PT_TGPLASMA'   ;
THETA0   = TAB1.<THETA0         ;
RHO0     = TAB1.<RHO0           ;
RP       = TAB1.<RP             ;
*------------------------------------
*
SI (NON ((VALEUR DIME) EGA 3)) ;
   ERRE '>>>> @VISIN only works on 3D geometries' ;
FINSI ;
*
*---- creation d'une nouvelle geometrie MAIL0V dans le repere local
*----      - l'origine O est placee au point tangent au plasma
*----      - l'axe OY est dirige vers le centre du plasma
*
VECT0 = CP MOINS PT ;
*
*---- verification de la valeur du petit rayon du plasma
RHO0 = NORM VECT0 ;
*---- verification que cette valeur est la meme que celle de TAB1.<RHO0
SI (EXISTE TAB1 <RHO0) ;
   SI ((ABS ((RHO0 - TAB1.<RHO0)/RHO0)) > 1.E-4) ;
      MESS '>>>> The computed value of the plasma radius is not';
      MESS '>>>> the same as the given one in TAB1.<RHO0.';
      MESS '>>>> You must check the coordinates of the CENTRE_PLASMA.';
      ERRE ' >>>> ERROR in @VISIN' ;
   FINSI ;
FINSI ;
*
VX = COOR 1 VECT0  ;
VY = COOR 2 VECT0  ;
VZ = COOR 3 VECT0  ;
P1 = 0. 0. 0. ;
P2 = 0. 0. 1. ;
VTRANS = PT MOINS P1 ;
SI (VY EGA 0.)    ;
   SI (VX EGA 0.) ;
      ANG1 = 0.   ;
   FINSI          ;
   SI (VX > 0.)   ;
      ANG1 = 90.  ;
   FINSI          ;
   SI (VX < 0.)   ;
      ANG1 = -90. ;
   FINSI          ;
SINON             ;
   ANG1 = ATG VX VY ;
FINSI             ;
*
MAIL0V = (MAIL0 MOINS VTRANS) TOUR ANG1 P1 P2 ;
*
VX1 = VX * (COS ANG1) - (VY * (SIN ANG1)) ;
VY1 = VX * (SIN ANG1) + (VY * (COS ANG1)) ;
VZ1 = VZ ;
*
SI (VY1 EGA 0.)    ;
   SI (VZ1 EGA 0.) ;
      ANG2 = 0.    ;
   FINSI           ;
   SI (VZ1 > 0.)   ;
      ANG2 = -90.  ;
   FINSI           ;
   SI (VZ1 < 0.)   ;
      ANG2 = 90.   ;
   FINSI           ;
SINON              ;
   ANG2 = -1.* (ATG VZ1 VY1) ;
FINSI              ;
*
P1 = 0. 0. 0. ;
P2 = 1. 0. 0. ;
MAIL0V = MAIL0V TOUR ANG2 P1 P2 ;
*
*---- creation des axes du repere local :
*----      - l'origine O est placee au point tangent au plasma
*----      - l'axe OY est dirige vers le centre du plasma
*---- avec OX en bleu, OY en blanc, OZ en rouge
DENS 0.1 ;
OB1 = 0. 0. 0. ;
OB2 = .1 0. 0. ;
OB3 = 0. .1 0. ;
OB4 = 0. 0. .1 ;
LX = (D OB2 OB1) COUL BLEU ;
LY = (D OB3 OB1) COUL BLAN ;
LZ = (D OB4 OB1) COUL ROUG ;
MAIL0V = MAIL0V ET LX ET LY ET LZ  ;
*TRACE (1000. -500. 1000.) FACE CACH MAIL0V ;
*
* ---- visualisation de la structure etudiee dans le tore
ABS1 = RHO0 * (SIN THETA0) * -1.  ;
ABS2 = RHO0 * (COS THETA0) + RHO0 ;
ABS3 = RP * (COS THETA0) + RHO0   ;
ABS4 = RP * (SIN THETA0)          ;
ABS5 = RHO0 * (SIN THETA0)        ;
ABS6 = RHO0 * (COS(70.+THETA0)) + RHO0 ;
ABS7 = RHO0 * (SIN(70.+THETA0)) ;
ABS8 = RHO0 * (COS(70.-THETA0)) + RHO0 ;
ABS9 = RHO0 * (SIN(70.-THETA0)) * -1. ;
*
CPLASMA = 0.   RHO0          0.   ;
CTORE   = 0.   ABS2       ABS4    ;
CAUX1   = 0.   ABS6       ABS7    ;
CAUX2   = 0.   ABS8       ABS9    ;
CAUX3   = 0.   ABS2       ABS5    ;
*
LIGPLAS = (CER3 OB1 CAUX1 CAUX2) ET
          (CER3 CAUX1 CAUX2 OB1) COUL ROSE ;
MAIL0V = MAIL0V ET LX ET LY ET LZ ET LIGPLAS ;
*TRACE (1000. -500. 1000.) FACE CACH MAIL0V;
*
*  ----
MENAGE ;
ANGROT1 = -1.* THETA0 ;
VECT1 = 0.   (-1.*RHO0*(COS THETA0) - RP)
                (RHO0*(SIN THETA0))  ;
MAIL0V = (MAIL0V TOUR ANGROT1 OB1 OB2) PLUS VECT1 ;
MAIL0V = MAIL0V TOUR 90. OB1 OB4 ;
CP1 = RP  0. 0. ;
CP2 = 0.  0. 1. ;
LIGTORE = (CP1 D 1 OB1 D 1 CP2) COUL TURQ ;
MAIL0V = MAIL0V ET LIGTORE ;
MENAGE ;
*
*---- multiplication des aiguilles sur le plancher
*aig*   MAIL0V = MAIL0V ET (MAIL0V TOUR 0.7 OB1 OB4)
*aig*              ET (MAIL0V TOUR 1.4 OB1 OB4)
*aig*              ET (MAIL0V TOUR 2.1 OB1 OB4)
*aig*              ET (MAIL0V TOUR 2.8 OB1 OB4) ;
*aig*   MENAGE ;
*aig*   MAIL0V = MAIL0V ET (MAIL0V TOUR 3.5 OB1 OB4) ;
*aig*   MENAGE ;
*
TITRE '@VISIN : MODELISED STRUCTURE IN THE TORE' ;
TRACE (0. -1000.  0.) FACE CACH MAIL0V ;
MESS '---------------------------------> exiting @VISIN';
FINPROC ;

DEBPROC  @VISRES  TAB1*TABLE ;
*
******************************************************************
* Procedure de visualisation des resultats d'un calcul permanent *
* en 3D.           Alain MOAL (aout-sept 1995)                   *
******************************************************************
*
MESS '---------------------------------> calling @VISRES';
*
ITER = 1 ;
*--------------- VARIABLES D'ENTREE :
MAIL0    = TAB1.<MAILLAGE ;
TEMP     = TAB1.TEMPERATURE ;
LIGCONV  = TAB1.LFLUX_CONV_DESS ;
SURFCONV = TAB1.LFLUX_CONV ;
SURFEXTE = TAB1.LFLUX_EXTE ;
TE1      = TAB1.ITER ;
VTETA1   = TAB1.RESUTHER.'VALEUR_TETA'.ITER ;
HCONV1   = TAB1.RESUTHER.COEFECHANGE.ITER ;
PROFIL0  = TAB1.V_VPAT1 ;
FLU0     = EXTR TAB1.LIS_FLUX ITER;
MODEL0   = TAB1.MODELF ;
LIG0     = TAB1.LFLUX_EXTE_DESS ;
MAXSOFL  = TAB1.MAX_SOFL   ;
DMAQ0    = TAB1.D_MAQUETTE ;
NX       = TAB1.C_COTETF1  ;
NY       = TAB1.C_SITETF1  ;
NZ       = TAB1.C_COS3F1   ;
VOLMAT1  = TAB1.ZONE_MAT.1 ;
VOLMAT2  = TAB1.ZONE_MAT.2 ;
VOLMAT3  = TAB1.ZONE_MAT.3 ;
ANGINCI  = TAB1.<ANGINCI;
*TEST*VBVN     = TAB1.<VBVN ;
SI ((DIME TAB1.<POINT_COUPE) EGA 3) ;
   P1 = TEXT (EXTR TAB1.<POINT_COUPE 1) ;
   P2 = TEXT (EXTR TAB1.<POINT_COUPE 2) ;
   P3 = TEXT (EXTR TAB1.<POINT_COUPE 3) ;
SINON ;
   ERRE '>>>> @VISRES : check TAB1.<POINT_COUPE' ;
FINSI ;
SI ((VALEUR DIME) EGA 3) ;
   OEIL0 = TAB1.VIEW_P ;
SINON ;
   ERRE '>>>> @VISRES only works on 3D geometries' ;
FINSI ;
*------------------------------------
*
*---- Table de visualisation
TAB2 = TABLE ;
TAB2.1 = 'MARQ CROI REGU MOT TITR FLUX' ;
TAB2.2 = 'MARQ TRIA REGU MOT TITR TEMPERATURE' ;
*
SI ((VALEUR DIME) NEG 3) ;
   ERRE '>>>> @VISRES only works on 3D modelisations';
FINSI ;
*
FLU1 = FLU0 * PROFIL0 ;
*
*---- Trace du flux incident, de la temperature et de l'angle d'incidence
*---- le long d'une ligne en fonction de l'abscisse curviligne
XM = COOR 1 LIG0 ;
LIG2 = CHAN SEG2 LIG0 ;
XCUR = EXTR (EVOL CHPO XM SCAL (INVE LIG0)) ABSC ;
CHXCUR = MANU CHPO (INVE LIG2) 1 SCAL XCUR ;
FLUXI = NOMC SCAL FLU1 ;
TEMP1 = NOMC SCAL TEMP ;
TITRE ' @VISRES : INCIDENT FLUX (W/m2) AND TEMPERATURE (1.E-4*C)';
EVFLUI = EVOL JAUN CHPO FLUXI SCAL LIG0 ;
EVTEMI = EVOL ROUG CHPO (TEMP1*1.E4) SCAL LIG0 ;
DESSIN (EVFLUI ET EVTEMI) MIMA LEGE TAB2 ;
TITRE ' @VISRES : ANGLE BETWEEN B AND N (degree)';
EVANGI = EVOL JAUN CHPO ANGINCI SCAL LIG0 ;
DESSIN EVANGI MIMA ;
*TEST*TITRE ' @VISRES : VBVN ';
*TEST*EVVBVN = EVOL JAUN CHPO VBVN SCAL LIG0 ;
*TEST*DESSIN EVVBVN MIMA ;
*
*---- Trace de l'evolution du flux de convection le long d'une ligne
VTETA0 = REDU (EXCO 'T' TE1) LIGCONV ;
SI (EGA (TYPE VTETA1) 'CHPOINT ');
   VTETA = EXCO 'T' VTETA1 ;
SINON ;
   VTETA = VTETA1 ;
FINSI ;
HCONV = EXCO 'H' HCONV1 ;
*
*---- flux de convection sur la ligne et temperatures sur la ligne
FLUCONV = HCONV * (VTETA0 - VTETA)  ;
TITRE '@VISRES : WALL FLUX (W/m2) AND WALL TEMPERATURE (1.E-5*C)' ;
EVFLUC = EVOL VERT CHPO FLUCONV SCAL LIGCONV ;
EVTEMC = EVOL TURQ CHPO (TEMP1*1.E5) SCAL LIGCONV ;
DESSIN (EVFLUC ET EVTEMC) MIMA LEGE TAB2 ;
*
*---- temperatures sur la ligne
*TITRE '@VISRES : WALL TEMPERATURE (C)' ;
*DESSIN (EVOL TURQ CHPO TEMP1 SCAL LIGCONV) MIMA ;
*
*---- flux de convection sur la surface de convection
FLUCONV0 = HCONV * (TE1 - VTETA) ;
*
*---- Calcul du facteur de concentration et de la puissance extraite
FACT0 = (MAXI FLUCONV0) / (MAXI FLU1);
FLUINT1 = FLUX MODEL0 FLU1 ;
FLUMOY = (MAXI(RESU FLUINT1)) / (MESU SURFEXTE) ;
PUI1 = MAXI(RESU FLUINT1) ;
*
*---- Trace en coupe des isovaleurs de temperature et des vecteurs flux
*---- incident et de convection
CHPX = EXCO SCAL (FLU1 * NX) UX ;
CHPY = EXCO SCAL (FLU1 * NY) UY ;
CHPZ = EXCO SCAL (FLU1 * NZ) UZ ;
CHPT = @ET (@ET CHPX CHPY) CHPZ ;
AMPLV1 = 10. * DMAQ0 / (2. * MAXSOFL) ;
VECFLUI = @VECADA CHPT (-1. * AMPLV1) 'ROUGE' ;
*FX = FLU1 * NX;
*FY = FLU1 * NY;
*FZ = FLU1 * NZ;
*VECFLUI = @CVECT FX FY FZ SURFEXTE VERT ;
TITRE '@VISRES : ISOTHERM IN SECTION' ;
TRAC OEIL0 COUPE P1 P2 P3 TEMP MAIL0;
*
*---- Trace des isovaleurs de temperature sans le maillage
TITRE '@VISRES : ISOTHERM, CONVECTED POWER 'PUI1' W';
SI (EGA (VALEUR ELEM) 'CUB8') ;
   ARET1 = ARETE VOLMAT1 ;
   ARET2 = ARETE VOLMAT2 ;
   ARET3 = ARETE VOLMAT3 ;
SINON ;
   ARET1 = ARETE VOLMAT1 40.;
   ARET2 = ARETE VOLMAT2 40.;
   ARET3 = ARETE VOLMAT3 40.;
FINSI ;
ARET0 = ARET1 ET ARET2 ET ARET3 ;
TRAC CACH OEIL0 7 TEMP MAIL0 ARET0 ;
TRAC CACH OEIL0 TEMP MAIL0 ARET0 ;
*
*---- Messages
MESS ' HIGHEST WALL TEMPERATURE (C)..........: ' (MAXI VTETA0);
MESS ' LOWEST WALL TEMPERATURE (C)...........: ' (MINI VTETA0);
MESS ' MEAN INCIDENT FLUX (W/m2).............: '  FLUMOY ;
MESS ' HIGHEST INCIDENT FLUX (W/m2)..........: ' (MAXI FLU1) ;
MESS ' LOWEST INCIDENT FLUX (W/m2)...........: ' (MINI FLU1) ;
MESS ' HIGHEST CONVECTION FLUX (W/m2)........: ' (MAXI FLUCONV0);
MESS ' LOWEST CONVECTION FLUX (W/m2).........: ' (MINI FLUCONV0);
MESS ' CONCENTRATION FACTOR .................: ' FACT0 ;
*
MESS '---------------------------------> exiting @VISRES';
FINPROC ;
**** @VNORM3D
DEBPROC @VNORM3D <MAIL1*MAILLAGE  <MAILD_1*MAILLAGE NIVEAU1/ENTIER;
*
* !!! R. MITTEAU !!! attention, procedure standard
*
* un pointeur dans /CASTEM9X/procedures pointe sur cette procedure
* pour les mises a jour
*
SI (NON (EXISTE NIVEAU1));
 MESS '---------------------------------> calling @VNORM3D';
SINON;
 SI (NIVEAU1 >EG 4);
 MESS '---------------------------------> calling @VNORM3D';
 FINSI;
FINSI;
SI (EGA (VALE MODE) 'AXIS') ;
 FX = 'FR' ;
 FY = 'FZ' ;
FINSI ;
MODL1    =  MODL <MAIL1 'MECANIQUE' 'ELASTIQUE'    ;
FPREF1   =  PRESSION MASS MODL1  -1.E5 <MAILD_1 ;
XFF1     = ( EXCO FX FPREF1 'SCAL' )                ;
YFF1     = ( EXCO FY FPREF1 'SCAL' )              ;
V_DIM1 = VALEUR 'DIME' ;
SI ( V_DIM1 EGA 2)  ;
 NORMDP1  =  ( (XFF1**2) + (YFF1**2) )**0.5;
 >COSDIR1 = XFF1 / NORMDP1 ;
 >COSDIR2 = YFF1 / NORMDP1 ;
 >COSDIR3 = >COSDIR1 * 0. ;
SINON  ;
 ZFF1     = ( EXCO FZ FPREF1 'SCAL' )                 ;
 NORMDP1  = ( (XFF1**2) + (YFF1**2) + (ZFF1**2) )**0.5 ;
 >COSDIR1 = XFF1 / NORMDP1 ;
 >COSDIR2 = YFF1 / NORMDP1 ;
 >COSDIR3 = ZFF1 / NORMDP1 ;
 FPREF2 = @ET ( MANU CHPO <MAIL1 3 FX 0. FY 0. FZ 0.)  FPREF1 ;
 CH_1  = CHAN 'CHAM' FPREF2 MODL1 'GRAVITE';
 CHPO1 = REDU <MAILD_1 (CHAN 'CHPO' MODL1 CH_1) ;
 SENS1 = PSCAL FPREF1 CHPO1 (MOTS FX FY FZ) (MOTS FX FY FZ) ;

 MASQ1 = SENS1 MASQUE INFERIEUR 0. ;
 MASQ2 = SENS1 MASQUE EGSUPE 0. ;
 MASQ3 = @ET (-1. * MASQ1)   MASQ2 ;

 >COSDIR1 = >COSDIR1 * MASQ3  ;
 >COSDIR2 = >COSDIR2 * MASQ3  ;
 >COSDIR3 = >COSDIR3 * MASQ3  ;
FINSI ;

SI (NON (EXISTE NIVEAU1));
 MESS '---------------------------------> exiting @VNORM3D';
SINON;
 SI (NIVEAU1 >EG 4);
  MESS '---------------------------------> exiting @VNORM3D';
 FINSI;
FINSI;

FINPROC >COSDIR1 >COSDIR2 >COSDIR3  ;
**** @VNORMAL
DEBPROC VNORMAL <MAIL1*MAILLAGE  <MAILD_1*MAILLAGE                ;
MESS '---------------------------------> Entree dans VNORMAL '    ;
  MODL1   =  MODL <MAIL1 'MECANIQUE' 'ELASTIQUE'                  ;
  FPREF1  =  PRESSION MASS MODL1  1.E5 <MAILD_1                   ;
  XFF1    = ( EXCO FX FPREF1 'SCAL' ) * -1.                       ;
  YFF1    = ( EXCO FY FPREF1 'SCAL' ) * -1.                       ;
  >TETHA1 =  ATG YFF1 ( XFF1 + 1.E-12)                            ;
  >COS1   =  ( COS >TETHA1 ) *  1.                                ;
  >SIN1   =  ( SIN >TETHA1 ) *  1.                                ;
MESS '---------------------------------> sortie  de  VNORMAL'     ;
FINPROC >TETHA1 >COS1 >SIN1                                       ;


***********************************************
*                Test de ITRC                 *
*        Alain MOAL - CS SI (Janvier 2004)    *
***********************************************
*
* --- options de calcul
*
opti echo 1   ;
opti elem cub8 ;
opti dime 3 ;
*opti trac x;

*+++++++++++++++++++++++++++++++++++++*
*               MAILLAGE              *
*+++++++++++++++++++++++++++++++++++++*
*
*----------------------------*
*     MAILLAGE OMBRE         *
*----------------------------*

* parametres de la geometrie:
d1 = 50.e-3;
d2 = 40.e-3;
d3 = 10.e-3;
dist1 = 0.05;
dist2 = 0.01;
*
n1 = 10;
n2 = 5;
n3 = 1;
*
* creation des points
*
OEIL0 = 1000. -1000. 1000. ;
v1 = 0. (-1.*d1) 0. ;
v2 = 0. 0. d2 ;
a1 = 0. 2.4 (-0.72) ;
a2 = a1 plus v1 ;
a3 = a2 plus v2 ;
a4 = a3 moins v1 ;
rep1 = ((0. 0. 0.) d 1 (3. 0. 0.))
       et ((0. 0. 0.) d 1 (0. 3. 0.))
       et ((0. 0. 0.) d 1 (0. 0. 3.));
*
* creation des lignes
*
l1 = a1 d n1 a2 ;
l2 = a2 d n2 a3 ;
l3 = a3 d n1 a4 ;
l4 = a4 d n2 a1 ;
*
* creation des surfaces
*
st_ombre = daller l1 l2 l3 l4 plan ;
*trac st_ombre ;
*
* creation des volumes
*
vt_ombre = st_ombre volu n3 tran ((-1.*d3) 0. 0.);
*trac v_ombre ;
*
*--------------------*
* MAILLAGE OMBRANT
*--------------------*
*
vect1 = dist1 0. dist2 ;
s_ombre = st_ombre plus vect1 ;
v_ombre = s_ombre volu n3 tran (d3 0. 0.);
si graph;
trac (((st_ombre et s_ombre) coul roug)
     et vt_ombre et v_ombre et rep1);
finsi;

* --- Calcul de l'ombrage
*
tab1 = table ;
*
tab1.<ITRAC = vrai ;
tab1.<TYPE_CALCUL = MOT 'AVEC_SHIFT_AVEC_RIPPLE' ;
*
*---- position  dans la machine
*
tab1.<CENTRE_TORE = (0. 0. 0.) ;

tab1.<POINT_SUR_AXE_TORE = (0. 0. 2.) ;

lig1 = tab1.<CENTRE_TORE d 1
tab1.<POINT_SUR_AXE_TORE;

tab1.<POINT_SUR_OBJET = a1 ;
tab1.<ANG_PHI0 = 0. ;
tab1.<RP       = 2.40 ;
tab1.<RHO0     = 720.E-3 ;
tab1.<HP       = 0.  ;

*---- parametres plasma
tab1.<IPLASMA  = -1.2E6  ;
tab1.<INTENS   = 1.1E3  ;
tab1.<LAMB     = 0.0    ;
tab1.<LAMBQREF = 10.E-3  ;
*
* --- passage des maillages
*
tab1.<maillage  = vt_ombre ;
tab1.lflux_exte = st_ombre ;
tab1.modelf     = modl vt_ombre thermique isotrope;

* remplissage de tab1

tab1.<S_OMBRE = st_ombre ;
tab1.<V_OMBRE_N = vt_ombre ;
tab1.<S_OMBRE_N = st_ombre ;

tab1.<S_OMBRANT = s_ombre ;
tab1.<V_OMBRANT_N = v_ombre ;
tab1.<S_OMBRANT_N = s_ombre ;

tab1.<METHODE_REMONTEE = 1 ;
tab1.<DIST_SANS_TEST = 0.001 ;
tab1.<PAS_SANS_TEST =  0.001 ;
tab1.<DIST_AVEC_TEST = 0.1 ;
tab1.<PAS_AVEC_TEST =  0.005 ;

TAB1.<REMONTEE = TABLE ;
TAB1.<REMONTEE.<POINT = TABLE ;
TAB1.<REMONTEE.<POINT.1 = st_ombre POIN 40;
TAB1.<REMONTEE.<POINT.2 = st_ombre POIN 45 ;

@ombrage tab1;

TITRE 'LIGNES DE CHAMP' ;
si graph;
TRAC OEIL0 (st_ombre ET s_ombre
ET TAB1.<REMONTEE.<LIGNE.1
ET TAB1.<REMONTEE.<LIGNE.2) ;

TITRE 'CONNECTION DISTANCE' ;
TRAC TAB1.<CHDIST st_ombre ;

TITRE 'OMBRE EN BLEU';
TRAC TAB1.<MASQOMB st_ombre ;
finsi;
*---- validation du resultat
PO1 = 0.0  2.37  -0.72 ;
PO2 = 0.0  2.365 -0.688 ;
VAL0 = EXTR TAB1.<CHDIST SCAL (st_ombre POIN PROC PO1) ;
VAL1 = EXTR TAB1.<CHDIST SCAL (st_ombre POIN PROC PO2) ;

SI (((VAL0 >EG 0.10099) ET (VAL0 <EG 0.10101))
  ET ((VAL1 >EG 0.050219) ET (VAL1 <EG 0.050221)));
   MESS 'RESULTAT CORRECT';
SINON ;
   MESS 'RESULTAT INCORRECT';  erreur  5;
FINSI ;

*opti donn 5 ;
fin ;