Procédures | Cast3M

* @POMI     PROCEDUR  BP208322  20/05/06    21:15:01     10605          
*-----------------------------------------------------------
******              PROCEDURE @POMI                   ******
*-----------------------------------------------------------
*
*    CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
*   A DISPOSITION DE LA COMMUNAUTE  CASTEM2000
* PAR  DELERUYELLE Fr.  (SOCOTEC-INDUSTRIE à l'IPSN/DES)
*
*-----------------------------------------------------------
*  CALCUL DU POLYNOME MINIMISANT LA DISTANCE A UNE EVOLUTION
*----------------------------------------------------------
'DEBP' @POMI EV0*'EVOLUTION' N*'ENTIER' PAS1/'FLOTTANT' MT1/'MOT' ;
'SI' ('EGA' N 0) ;
  'MESS' '    ' ;
  'MESS' '*** POMI ==> Il faut un degré supérieur ou égal à 1' ;
  'MESS' '    ' ;
'SINON' ;
LX = 'EXTR' EV0 'ABSC' ;
LY = 'EXTR' EV0 'ORDO' ;
GN = 'DIME' LX ;
LKJU = 'PROG' ; LFU = 'PROG' ;
 
* CALCUL DES COEF K
U = -1 ;
'REPE' BOU1 (N + 1) ;
  U = U + 1 ;
  J = -1 ;
  'REPE' BOU2 (U + 1) ;
    J = J + 1 ;
    SOM = 0 ;
    I = 0 ;
    'REPE' BOU3 (GN - 1) ;
      I = I + 1 ;
      XI = 'EXTR' LX I ;
      XIP1 = 'EXTR' LX (I + 1) ;
  SOM = SOM + (( XIP1 ** (J + U + 1)) - (XI ** (J + U + 1))) ;
    'FIN' BOU3 ;
    KJU = SOM / (J + U + 1) ;
    LKJU = LKJU 'ET' ('PROG' KJU) ;
  'FIN' BOU2 ;
'FIN' BOU1 ;
 
* CALCUL DES COEF F
U = -1 ;
'REPE' BOU4 (N + 1) ;
  U = U + 1 ;
  I = 0 ;
  SOM1 = 0 ; SOM2 = 0 ;
  'REPE' BOU5 (GN - 1) ;
    I = I + 1 ;
    XI = 'EXTR' LX I ;
    XIP1 = 'EXTR' LX (I + 1) ;
    YI = 'EXTR' LY I ;
    YIP1 = 'EXTR' LY (I + 1) ;
    PENTE = (YIP1 - YI) / (XIP1 - XI) ;
 SOM1 = SOM1 + (((XIP1 ** (U + 1)) - (XI ** (U + 1))) *
               (YI - (PENTE * XI))) ;
 SOM2 = SOM2 + (((XIP1 ** (U + 2)) - (XI ** (U + 2))) * PENTE) ;
  'FIN' BOU5 ;
  FU = (SOM1 / (U + 1)) + (SOM2 / (U + 2)) ;
  LFU = LFU 'ET' (PROG FU) ;
'FIN' BOU4 ;
 
* CREATION D UNE GEOMETRIE FICTIVE
'SI' ('EGA' ('VALE' 'DIME') 3) ;
  GEO = 0 0 0 ; NP = 0 ;
  'REPE' BOU63 N ;
    NP = NP + 1 ;
    GEO = GEO 'ET' (NP 0. 0.) ;
  'FIN' BOU63 ;
'SINON' ;
  'SI' ('NON' ('EGA' ('VALE' 'DIME') 2)) ;
    'MESS' '*** POMI ==> On se met en dimension 2 pour résoudre.' ;
    'OPTI' 'DIME' 2 ;
  'FINSI' ;
  GEO = 0 0 ; NP = 0 ;
  'REPE' BOU6 N ;
    NP = NP + 1 ;
    GEO = GEO 'ET' (NP 0.) ;
  'FIN' BOU6 ;
'FINSI' ;
 
* ON DEFINIT LA RIGIDITE
GEO1 = 'MANU' 'SUPE' GEO ;
RI = 'MANU' 'RIGIDITE' TYPE 'RIGIDITE' GEO1 ('MOTS' 'T') LKJU ;
 
* ON DEFINIT LE SECOND MEMBRE
FO = 'MANU' 'CHPO' GEO 1 'Q' LFU ;
 
* ON RESOUD LE SYSTEME D EQUATION
CA = 'RESO' RI FO ;
 
* ON EXTRAIT LES TERMES DU POLYNOME
TA = 'TABLE' ; NA = -1 ;
'REPE' BOU7 (N + 1) ;
  NA = NA + 1 ;
  TA.NA = 'EXTR' CA 'T' (GEO 'POIN' (NA + 1)) ;
'FIN' BOU7 ;
 
* ON TRACE LE POLYNOME
'SI' ('EXISTE' MT1) ;
  'SI' ('EGA' MT1 IDEM ) ;
    XX = LX ; YY = PROG ('DIME' XX) * (TA.0) ;
    'SI' ('EXISTE' PAS1) ;
      'MESS' '    ' ;
      'MESS' '*** POMI ==> Option IDEM, le pas ' PAS1 'est ignoré' ;
      'MESS' '    ' ;
    'FINSI' ;
    NA = 0 ;
    'REPE' BOU9 N ;
      NA = NA + 1 ;
      YY = YY + ((XX ** NA) * (TA.NA)) ;
    'FIN' BOU9 ;
  'SINON' ;
    'MESS' '    ' ;
    'MESS' '*** POMI ==> Mot clé: ' MT1 ' incorrect.' ;
    'MESS' '    ' ;
  'FINSI' ;
'SINON' ;
  X1  = 'EXTR' LX 1 ;
  XGN = 'EXTR' LX GN ;
  'SI' ('NON' ('EXISTE' PAS1)) ;
    PAS1 = ((XGN - X1) / (GN - 1)) / 4. ;
  'FINSI' ;
  XX = 'PROG' X1 'PAS' PAS1 XGN ; YY = PROG ('DIME' XX) * (TA.0) ;
    NA = 0 ;
    'REPE' BOU10 N ;
      NA = NA + 1 ;
      YY = YY + ((XX ** NA) * (TA.NA)) ;
    'FIN' BOU10 ;
'FINSI' ;
EV1 = 'EVOL' 'ROUG' 'MANU' 'X' XX 'Y' YY ;
'FINSI' ;
'FINP' TA EV1 ;