Procédures | Cast3M

* TOPOFONC  PROCEDUR  FD218221  25/12/18    21:15:07     12429          
 
************************************************************************
** Procedure providing various functions used by TOPOPTIM
** (penalization, projection, etc.) and their derivatives.
**
** Author:
** Guenhael Le Quilliec (LaMe - Polytech Tours)
**
** Version:
** 1.0 2025/11/13 Initial version
************************************************************************
 
DEBP TOPOFONC ;
 
* Input data
* **********
 
ARGU option1/'MOT' ;
ARGU option2/'MOT' ;
ARGU option3/'MOT' ;
ARGU X*'MCHAML' ;
 
* Initialization
typ  = MOT ' ' ;
Lval = FAUX ;
LdX  = FAUX ;
 
* Options
SI (EXIS option1) ;
    SI (EGA option1 'VALEUR') ;
        Lval = VRAI ;
    SINO ;
        SI (EGA option1 'DERIVEE') ;
            LdX = VRAI ;
        SINO ;
            typ = MOT option1 ;
        FINS ;
    FINS ;
FINS ;
SI (EXIS option2) ;
    SI (EGA option2 'VALEUR') ;
        Lval = VRAI ;
    SINO ;
        SI (EGA option2 'DERIVEE') ;
            LdX = VRAI ;
        SINO ;
            typ = MOT option2 ;
        FINS ;
    FINS ;
FINS ;
SI (EXIS option3) ;
    SI (EGA option3 'VALEUR') ;
        Lval = VRAI ;
    SINO ;
        SI (EGA option3 'DERIVEE') ;
            LdX = VRAI ;
        SINO ;
            typ = MOT option3 ;
        FINS ;
    FINS ;
FINS ;
SI ((NON Lval) ET (NON LdX)) ;
    Lval = VRAI ;
FINS ;
 
**********************************************************************
*                       PENALIZATION FUNCTIONS                       *
**********************************************************************
 
* SIMP and modified SIMP
* **********************
 
SI (EGA typ 'SIMP') ;
*   Specific inputs
    ARGU p*'FLOTTANT' F1 ;
    ARGU tmp1/'FLOTTANT' tmp2/'MCHAML' ;
    SI (EXIS tmp1) ;
       F2 = tmp1 ;
    FINS ;
    SI (EXIS tmp2) ;
       F2 = tmp2 ;
    FINS ;
*   SIMP
    SI (NON (EXIS F2)) ;
        SI Lval ;
            fld = F1 * (X ** p) ;
        FINS ;
        SI LdX ;
            dfld = (F1 * p) * (X ** (p - 1.0)) ;
        FINS ;
*   Modified SIMP
    SINO ;
        dif = F2 - F1 ;
        SI Lval ;
            fld = F1 + (dif * (X ** p)) ;
        FINS ;
        SI LdX ;
            dfld = (dif * p) * (X ** (p - 1.0)) ;
        FINS ;
    FINS ;
FINS ;
 
* RAMP
* ****
 
SI (EGA typ 'RAMP') ;
*   Specific inputs
    ARGU q*'FLOTTANT' minfld maxfld ;
    dif = maxfld - minfld ;
    tmp = (1.0 + q) - (q * X) ;
*   Compute F
    SI Lval ;
        fld = minfld + ((dif * X) / tmp) ;
    FINS ;
*   Compute dF
    SI LdX ;
        dfld = (dif * (1.0 + q)) / (tmp ** 2) ;
    FINS ;
FINS ;
 
**********************************************************************
*                        PROJECTION FUNCTIONS                        *
**********************************************************************
 
* Heaviside, Guest et al. (2004)
* ******************************
 
SI (EGA typ 'GUEST_2004') ;
*   Specific input
    ARGU bta*'FLOTTANT' eta/'FLOTTANT' ;
    tmp1 = EXP ((-1.0 * bta) * X) ;
    tmp2 = EXP (-1.0 * bta) ;
*   Compute F
    SI Lval ;
        fld = (1.0 - tmp1) + (X * tmp2) ;
    FINS ;
*   Compute dF
    SI LdX ;
        dfld = (bta * tmp1) + tmp2 ;
    FINS ;
FINS ;
 
* Shifted hyperbolic sigmoid
* **************************
 
SI (EGA typ 'SIGMOID_TANH') ;
*   Specific inputs
    ARGU bta*'FLOTTANT' eta/'FLOTTANT' ;
    SI (NON (EXIS eta)) ;
        eta = 0.0 ;
    FINS ;
*   Normalized hyperbolic sigmoid
    SI (EGA eta 0.0) ;
        tmp1 = TANH (bta * X) ;
        tmp2 = TANH bta ;
*       Compute F
        SI Lval ;
            fld = tmp1 / tmp2 ;
        FINS ;
*       Compute dF
        SI LdX ;
            dfld = (bta / tmp2) * (1.0 - (tmp1 ** 2)) ;
        FINS ;
    SINO ;
*       Centered hyperbolic sigmoid
        SI (EGA eta 0.5) ;
            tmp1 = TANH (bta * (X  - 0.5)) ;
            tmp2 = TANH (bta * 0.5) ;
*           Compute F
            SI Lval ;
                fld = (tmp1 + tmp2) / (2.0 * tmp2) ;
            FINS ;
*           Compute dF
            SI LdX ;
                dfld = (bta / (2.0 * tmp2)) * (1.0 - (tmp1 ** 2)) ;
            FINS ;
*       Shifted hyperbolic sigmoid
        SINO ;
            tmp1 = TANH (bta * eta) ;
            tmp2 = TANH (bta * (X  - eta)) ;
            tmp3 = TANH (bta * (1.0 - eta)) ;
*           Compute F
            SI Lval ;
                fld = (tmp1 + tmp2) / (tmp1 + tmp3) ;
            FINS ;
*           Compute dF
            SI LdX ;
                dfld = (bta / (tmp1 + tmp3)) * (1.0 - (tmp2 ** 2)) ;
            FINS ;
        FINS ;
    FINS ;
FINS ;
 
* Output data
* ***********
 
SI Lval ;
    RESP fld ;
FINS ;
SI LdX ;
    RESP dfld ;
FINS ;
 
FINP ;