Procédures | Cast3M

* FILMTOPO  PROCEDUR  GOUNAND   26/06/09    21:15:06     12566          
************************************************************************
* NOM         : FILMTOPO
* DESCRIPTION : Fait un film avec la table de sortie de REMA ou TRIA
*               'TOPO'
*               Cette table contient une sequence de maillage en format
*               compresse a l'indice seqtopo (on n'a stocke que les
*               differences entre deux maillages consecutifs)
*
*               En entree, on a demande la sortie de tous les maillages
*               avec :
*               tparam = tabl ;
*               tparam . 'sort_seqm' = 1 ;
*               mailap = REMA mailav metriq tparam ;
*               FILMTOPO tparam ;
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
*               mail : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 02/06/2026, version initiale
* HISTORIQUE : v1, 02/06/2026, creation
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'DEBPROC' FILMTOPO ;
'ARGU' tfilm*'TABLE' ;
'ARGUMENT' motcle/'MOT' ;
*
'SI' ('EXIS' motcle) ;
*
   lmotcle = 'MOTS' 'IMPR' ;
   'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
      'ERRE' 1052 'AVEC' motcle 'IMPR' ;
   'FINSI' ;
   limpr = vrai ;
'SINO' ;
   limpr = faux ;
'FINS' ;
*
tok = 'EXIS' tparam 'sort_seqm' ;
'SI' tok ;
   tok = 'EGA' (tparam . 'sort_seqm') 1 ;
'FINS' ;
'SI' ('NON' tok) ;
   'ERRE' 'tparam . ''sort_seqm'' NEG 1' ;
'FINS' ;
* Filmons
seqtopo  = tparam . 'seqtopo' ;
metva    = tparam . 'metrique' ;
lmet = ('NEG' metva faux) ;
*
tstat    = tparam . 'tstat' ;
lnchange = tstat  . 'lnchange' ;
lipass   = tstat  . 'lipass' ;
lpcritq = tparam . 'critquals_eff' ; dlp = 'DIME' lpcritq ; lcritq = 'EXTR' lpcritq dlp ;
* Consistance
nmail  = ('SOMM' lnchange) '+' 1 ;
dim3 = ('DIME' seqtopo) '-' 1 ;
dim = dim3 '/' 3 ;
'SI' ('NEG' ('*' dim 3) dim3) ;
   'ERRE' 'Dimension liste maillage non divisible par 3' ;
'FINS' ;
nmail2 = dim '+' 1 ;
'SI' ('NEG' nmail nmail2) ;
   'ERRE' 'Pb nombre de maillage' ;
'FINS' ;
'SI' limpr ;
   'MESS' 'FILMTOPO: Nombre de maillages=' nmail ;
'FINS' ;
idxtopo = 1 ;
curtopo = 'EXTR' seqtopo idxtopo ;
imail = 1 ;
netap = 'DIME' lnchange ;
'SI' limpr ;
   'MESS' 'FILMTOPO: Nombre d''etapes=' netap ;
'FINS' ;
lfirst = vrai ;
vdim = 'VALE' 'DIME' ;
'REPE' iietap netap ;
   ietap = &iietap ;
   nchange = 'EXTR' lnchange ietap ;
   ipass   = 'EXTR' lipass   ietap ;
   lcritq  = 'EXTR' lpcritq ipass  ;
   jcritq = 'ENTI' ('EXTR' lcritq 1) 'PROC' ;
   'SI' lmet ;
      pcritq = 'EXTR' lcritq 2 ;
      qcritq = 'EXTR' lcritq 3 ;
   'FINS' ;
   'SI' lfirst ;
      'SI' lmet ;
         qcurt = 'INDI' 'TOPO' curtopo metva lcritq ;
      'SINO' ;
         qcurt = 'INDI' 'TOPO' curtopo lcritq ;
      'FINS' ;
      qcurtg = 'CHAN' qcurt ('MODE' ('EXTR' qcurt 'MAIL') 'THERMIQUE') 'GRAVITE' ;
      lr = 'EXTR' qcurtg 'VALE' 'TOPO' ;
      lro = 'ORDO' lr ; dlr = 'DIME' lr ;
      miq = 'EXTR' lro 1 ; maq = 'EXTR' lro dlr ;
      meq = 'EXTR' lro ('/' ('+' 1 dlr) 2) ;
      txt2 = 'CHAI'  'FORMAT' '(E11.3)' imail ' /' ' ' nmail ' pass' ' ' ipass
               '  Qmin=' miq ' Qmax=' maq ' Qmed=' meq ' crit=' jcritq ;
      'SI' lmet ;
         txt2 = 'CHAINE' 'FORMAT' '(F4.1)' txt2 ' p=' pcritq ' q=' qcritq ;
      'FINS' ;
      'SI' limpr ;
         'MESS' 'FILMTOPO:' ' ' txt2 ;
      'FINS' ;
      'SI' ('&lt;EG' vdim 2) ;
         'TRAC' curtopo 'TITR' txt2 ;
      'SINO' ;
         curtopoq = 'CHAN' curtopo 'QUAF' ;
         'TRAC' 'CACH' curtopoq 'TITR' txt2 ;
      'FINS' ;
      lfirst = faux ;
   'FINS' ;
   'REPE' iichange nchange ;
      ichange = &iichange ;
      imail = imail '+' 1 ;
      idxtopo = '+' idxtopo 1 ;
      lmi = 'EXTR' seqtopo idxtopo;
      idxtopo = '+' idxtopo 1 ;
      topoavi = 'EXTR' seqtopo idxtopo ;
      curtopo = 'DIFF' curtopo topoavi ;
      idxtopo = '+' idxtopo 1 ;
      topoapi = 'EXTR' seqtopo idxtopo ;
      curtopo = curtopo 'ET' topoapi ;
      'SI' lmet ;
         qcurt = 'INDI' 'TOPO' curtopo metva lcritq ;
      'SINO' ;
         qcurt = 'INDI' 'TOPO' curtopo lcritq ;
      'FINS' ;
      qcurtg = 'CHAN' qcurt ('MODE' ('EXTR' qcurt 'MAIL') 'THERMIQUE') 'GRAVITE' ;
      lr = 'EXTR' qcurtg 'VALE' 'TOPO' ;
      lro = 'ORDO' lr ; dlr = 'DIME' lr ;
      miq = 'EXTR' lro 1 ; maq = 'EXTR' lro dlr ;
      meq = 'EXTR' lro ('/' ('+' 1 dlr) 2) ;
      txt2 = 'CHAI'  'FORMAT' '(E11.3)' imail ' /' ' ' nmail ' pass' ' ' ipass
                     '  Qmin=' miq ' Qmax=' maq ' Qmed=' meq ' crit=' jcritq ;
      'SI' lmet ;
         txt2 = 'CHAINE' 'FORMAT' '(F4.1)' txt2 ' p=' pcritq ' q=' qcritq ;
      'FINS' ;
      'SI' limpr ;
         'MESS' 'FILMTOPO:' ' ' txt2 ;
      'FINS' ;
      'SI' ('&lt;EG' vdim 2) ;
         'TRAC' curtopo 'TITR' txt2 ;
      'SINO' ;
         curtopoq = 'CHAN' curtopo 'QUAF' ;
         'TRAC' 'CACH' curtopoq 'TITR' txt2 ;
      'FINS' ;
   'FIN' iichange ;
'FIN' iietap ;
*
* End of procedure file FILMTOPO
*
'FINPROC' ;