Procedures | Cast3M

   1 : * @POMI     PROCEDUR  PYROS1    96/07/16    21:15:03     2225           
   2 : *-----------------------------------------------------------
   3 : ******              PROCEDURE @POMI                   ******
   4 : *-----------------------------------------------------------
   5 : *
   6 : *    CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
   7 : *   A DISPOSITION DE LA COMMUNAUTE  CASTEM2000
   8 : * PAR  DELERUYELLE Fr.  (SOCOTEC-INDUSTRIE à l'IPSN/DES)
   9 : *
  10 : *-----------------------------------------------------------
  11 : *  CALCUL DU POLYNOME MINIMISANT LA DISTANCE A UNE EVOLUTION
  12 : *----------------------------------------------------------
  13 : 'DEBP' @POMI EV0*'EVOLUTION' N*'ENTIER' PAS1/'FLOTTANT' MT1/'MOT' ;
  14 : 'SI' ('EGA' N 0) ;
  15 :   'MESS' '    ' ;
  16 :   'MESS' '*** POMI ==> Il faut un degré supérieur ou égal à 1' ;
  17 :   'MESS' '    ' ;
  18 : 'SINON' ;
  19 : LX = 'EXTR' EV0 'ABSC' ;
  20 : LY = 'EXTR' EV0 'ORDO' ;
  21 : GN = 'DIME' LX ;
  22 : LKJU = 'PROG' ; LFU = 'PROG' ;
  23 : 
  24 : * CALCUL DES COEF K
  25 : U = -1 ;
  26 : 'REPE' BOU1 (N + 1) ;
  27 :   U = U + 1 ;
  28 :   J = -1 ;
  29 :   'REPE' BOU2 (U + 1) ;
  30 :     J = J + 1 ;
  31 :     SOM = 0 ;
  32 :     I = 0 ;
  33 :     'REPE' BOU3 (GN - 1) ;
  34 :       I = I + 1 ;
  35 :       XI = 'EXTR' LX I ;
  36 :       XIP1 = 'EXTR' LX (I + 1) ;
  37 :   SOM = SOM + (( XIP1 ** (J + U + 1)) - (XI ** (J + U + 1))) ;
  38 :     'FIN' BOU3 ;
  39 :     KJU = SOM / (J + U + 1) ;
  40 :     LKJU = LKJU 'ET' ('PROG' KJU) ;
  41 :   'FIN' BOU2 ;
  42 : 'FIN' BOU1 ;
  43 : 
  44 : * CALCUL DES COEF F
  45 : U = -1 ;
  46 : 'REPE' BOU4 (N + 1) ;
  47 :   U = U + 1 ;
  48 :   I = 0 ;
  49 :   SOM1 = 0 ; SOM2 = 0 ;
  50 :   'REPE' BOU5 (GN - 1) ;
  51 :     I = I + 1 ;
  52 :     XI = 'EXTR' LX I ;
  53 :     XIP1 = 'EXTR' LX (I + 1) ;
  54 :     YI = 'EXTR' LY I ;
  55 :     YIP1 = 'EXTR' LY (I + 1) ;
  56 :     PENTE = (YIP1 - YI) / (XIP1 - XI) ;
  57 :  SOM1 = SOM1 + (((XIP1 ** (U + 1)) - (XI ** (U + 1))) *
  58 :                (YI - (PENTE * XI))) ;
  59 :  SOM2 = SOM2 + (((XIP1 ** (U + 2)) - (XI ** (U + 2))) * PENTE) ;
  60 :   'FIN' BOU5 ;
  61 :   FU = (SOM1 / (U + 1)) + (SOM2 / (U + 2)) ;
  62 :   LFU = LFU 'ET' (PROG FU) ;
  63 : 'FIN' BOU4 ;
  64 : 
  65 : * CREATION D UNE GEOMETRIE FICTIVE
  66 : 'SI' ('EGA' ('VALE' 'DIME') 3) ;
  67 :   GEO = 0 0 0 ; NP = 0 ;
  68 :   'REPE' BOU63 N ;
  69 :     NP = NP + 1 ;
  70 :     GEO = GEO 'ET' (NP 0. 0.) ;
  71 :   'FIN' BOU63 ;
  72 : 'SINON' ;
  73 :   'SI' ('NON' ('EGA' ('VALE' 'DIME') 2)) ;
  74 :     'MESS' '*** POMI ==> On se met en dimension 2 pour résoudre.' ;
  75 :     'OPTI' 'DIME' 2 ;
  76 :   'FINSI' ;
  77 :   GEO = 0 0 ; NP = 0 ;
  78 :   'REPE' BOU6 N ;
  79 :     NP = NP + 1 ;
  80 :     GEO = GEO 'ET' (NP 0.) ;
  81 :   'FIN' BOU6 ;
  82 : 'FINSI' ;
  83 : 
  84 : * ON DEFINIT LA RIGIDITE
  85 : GEO1 = 'MANU' 'SUPE' GEO ;
  86 : RI = 'MANU' 'RIGIDITE' TYPE 'RIGIDITE' GEO1 ('MOTS' 'T') LKJU ;
  87 : 
  88 : * ON DEFINIT LE SECOND MEMBRE
  89 : FO = 'MANU' 'CHPO' GEO1 1 'Q' LFU ;
  90 : 
  91 : * ON RESOUD LE SYSTEME D EQUATION
  92 : CA = 'RESO' RI FO ;
  93 : 
  94 : * ON EXTRAIT LES TERMES DU POLYNOME
  95 : TA = 'TABLE' ; NA = -1 ;
  96 : 'REPE' BOU7 (N + 1) ;
  97 :   NA = NA + 1 ;
  98 :   TA.NA = 'EXTR' CA 'T' (GEO 'POIN' (NA + 1)) ;
  99 : 'FIN' BOU7 ;
 100 : 
 101 : * ON TRACE LE POLYNOME
 102 : 'SI' ('EXISTE' MT1) ;
 103 :   'SI' ('EGA' MT1 IDEM ) ;
 104 :     XX = LX ; YY = PROG ('DIME' XX) * (TA.0) ;
 105 :     'SI' ('EXISTE' PAS1) ;
 106 :       'MESS' '    ' ;
 107 :       'MESS' '*** POMI ==> Option IDEM, le pas ' PAS1 'est ignoré' ;
 108 :       'MESS' '    ' ;
 109 :     'FINSI' ;
 110 :     NA = 0 ;
 111 :     'REPE' BOU9 N ;
 112 :       NA = NA + 1 ;
 113 :       YY = YY + ((XX ** NA) * (TA.NA)) ;
 114 :     'FIN' BOU9 ;
 115 :   'SINON' ;
 116 :     'MESS' '    ' ;
 117 :     'MESS' '*** POMI ==> Mot clé: ' MT1 ' incorrect.' ;
 118 :     'MESS' '    ' ;
 119 :   'FINSI' ;
 120 : 'SINON' ;
 121 :   X1  = 'EXTR' LX 1 ;
 122 :   XGN = 'EXTR' LX GN ;
 123 :   'SI' ('NON' ('EXISTE' PAS1)) ;
 124 :     PAS1 = ((XGN - X1) / (GN - 1)) / 4. ;
 125 :   'FINSI' ;
 126 :   XX = 'PROG' X1 'PAS' PAS1 XGN ; YY = PROG ('DIME' XX) * (TA.0) ;
 127 :     NA = 0 ;
 128 :     'REPE' BOU10 N ;
 129 :       NA = NA + 1 ;
 130 :       YY = YY + ((XX ** NA) * (TA.NA)) ;
 131 :     'FIN' BOU10 ;
 132 : 'FINSI' ;
 133 : EV1 = 'EVOL' 'ROUG' 'MANU' 'X' XX 'Y' YY ;
 134 : 'FINSI' ;
 135 : 'FINP' TA EV1 ;
 136 :