Procédures | Cast3M

* FILMTOPO  PROCEDUR  GOUNAND   26/07/06    21:15:05     12592          
************************************************************************
* 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' ;
'ARGU' nimgmax/'ENTIER' ;
'SI' ('NON' ('EXIS' nimgmax)) ;
   nimgmax = 600 ;
'FINS' ;
nimpmax = 100 ;
'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' ;
vdim = 'VALE' 'DIME' ;
dximp = '/' ('FLOT' nmail) ('FLOT' nimpmax) ; ximp  = 0. ;
dximg = '/' ('FLOT' nmail) ('FLOT' nimgmax) ; ximg  = 0. ;
*
'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' ;
   'REPE' iichange ('+' nchange 1) ;
      ichange = &iichange ;
      'SI' ('>' ichange 1) ;
         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 ;
      'FINS' ;
      limg = ('>' imail ximg) ;
      limp = ('>' imail ximp) ;
      'SI' limg ; ximg = ximg '+' dximg ; 'FINS' ;
      'SI' limp ; ximp = ximp '+' dximp ; 'FINS' ;
      'SI' (('ET' limp limpr) 'OU' limg) ;
         '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' ('ET' limpr limp) ;
            'MESS' 'FILMTOPO:' ' ' txt2 ;
         'FINS' ;
         'SI' limg ;
            'SI' ('&lt;EG' vdim 2) ;
               'TRAC' curtopo 'TITR' txt2 ;
            'SINO' ;
               curtopoq = 'CHAN' curtopo 'QUAF' ;
               'TRAC' 'CACH' curtopoq 'TITR' txt2 ;
            'FINS' ;
         'FINS' ;
      'FINS' ;
   'FIN' iichange ;
'FIN' iietap ;
*
* End of procedure file FILMTOPO
*
'FINPROC' ;