Sources Esope | Cast3M

nnor
C NNOR      SOURCE    CB215821  20/11/25    13:34:50     10792          
      SUBROUTINE NNOR
************************************************************************
* NOM         : NNOR
* DESCRIPTION : La directive NNOR rend un objet unitaire au sens de la
*               norme infinie (par defaut) ou de la norme Euclidienne.
************************************************************************
* APPELE PAR : pilot.eso
************************************************************************
* SOUS-PROGRAMMES : norma3 => norme sup d'un objet CHPOINT
*                   norma5 => norme sup d'un objet TABLE
*                   normb3 => norme 2   d'un objet CHPOINT
*                   normb5 => norme 2   d'un objet TABLE
************************************************************************
* SYNTAXE (GIBIANE) :
*
*    1) NORME INFINIE
*
*       NNOR  ('INFI')  OBJET1  ( | ('AVEC') | LMOTS1 )  ...
*                                 |  'SANS'  |
*
*                      ...  ('RORF' VAL1 'CREF' VAL2 'LCAR' VAL3)  ;
*
*
*    2) NORME EUCLIDIENNE
*
*       NNOR   'EUCL'   OBJET1   (RIGID1)  ;
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)      
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC SMCHPOI
*
c       REAL*8 VNOR,PGRAND,FLUI(3),COEFP,COEFPI,RET
      REAL*8 FLUI(3)
*
      PARAMETER (NBTYPE = 2)
      PARAMETER (LCLEF  = 5)
      PARAMETER (LNORM  = 2)
*
      CHARACTER*8 LISTYP(NBTYPE),MONTYP,CHA8
      CHARACTER*4 MOCLEF(LCLEF),MONORM(LNORM)
      CHARACTER*(LOCOMP) MOTCLE
*
      DATA LISTYP/'CHPOINT ','TABLE   '/
      DATA MOCLEF/'RORF','CREF','LCAR','AVEC','SANS'/
      DATA MONORM/'INFI','EUCL'/
 
      IFLUI=0
      INORM=1
      MOTCLE = ' '
*
*     LECTURE DU TYPE DE NORME
*     ========================
      ICODE = 0
      CALL LIRMOT(MONORM,LNORM,IVAL,ICODE)
      IF (IVAL .GT. 1) INORM=IVAL
*
*
      IF (INORM.EQ.1) THEN
*
*        LECTURE DES MOTS-CLES
*        =====================
  1      ICODE = 0
         CALL LIRMOT(MOCLEF,LCLEF,IVAL,ICODE)
         IF(IVAL.EQ.1 .OR.  IVAL.EQ.2  .OR.  IVAL.EQ.3) THEN
             CALL LIRREE(RET,1,IRETOU)
             IF(IERR.NE.0) RETURN
             FLUI(IVAL)=RET
             IFLUI=IFLUI + 2**IVAL
         ELSEIF (IVAL.EQ.4 .OR. IVAL.EQ.5) THEN
             MOTCLE=MOCLEF(IVAL)
         ELSE
             GOTO 2
         ENDIF
         GOTO 1
*
*        LECTURE DE LA LISTE DES COMPOSANTES
*        ===================================
  2      ICODE = 0
         CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
         IF (IRETOU .EQ. 0) THEN
            IPLMOT = 0
         ELSE IF (MOTCLE .EQ. ' ') THEN
*           PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES
*           PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES)
            MOTCLE = 'AVEC'
         END IF
 
      ELSEIF (INORM.EQ.2) THEN
*
*        LECTURE DE LA MATRICE
*        =====================
         ICODE=0
         CALL LIROBJ('RIGIDITE',IRIG1,ICODE,IZRIG)
*         
      ENDIF
*
*
*     LECTURE DE L'OBJET
*     ==================
      CALL QUETYP(MONTYP,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL ERREUR(533)
         RETURN
      ENDIF
 
      CALL PLACE(LISTYP,NBTYPE,IPOS,MONTYP)
      IF(IPOS .EQ. 0)THEN  
        MOTERR(1:8)=MONTYP
        CALL ERREUR(39)
        RETURN
      ENDIF
 
      IF (IPOS.EQ.2) THEN
         CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
         IF (IRETOU .NE. 0) THEN
           IPOINT = ITBAS
 
         ELSE
            CALL LIRTAB('BASE_MODALE',IPOINT,0,IRETOU)
            IF (IRETOU.NE.0) THEN
              CHA8=' '
              CALL ACMO(IPOINT,'MODES',CHA8,ITBAS)
              IF (CHA8.NE.'TABLE' .OR. ITBAS .LE. 0) THEN
                CALL ERREUR(647)
                RETURN
              ENDIF
 
            ELSE
              MOTERR(1:8)='TABLE'
              CALL ERREUR(302)
              RETURN
            ENDIF
         ENDIF
 
      ELSE
         CALL LIROBJ(MONTYP,IPOINT,1,IRETOU)
         CALL ACTOBJ(MONTYP,IPOINT,1)
C          Copie du CHPOINT (OPERATEUR)
           MCHPOI=IPOINT
           SEGINI,MCHPO1=MCHPOI
           IPOINT=MCHPO1
      ENDIF
      IF (IERR.NE.0) RETURN
*
*
*     NORMALISATION
*     =============
      IF(IFLUI.EQ.0) THEN
          COEFP =0.D0
          COEFPI=0.D0
      ELSE IF(IFLUI.EQ.14) THEN
          IF(FLUI(3).EQ.0.D0) THEN
             CALL ERREUR(284)
             RETURN
          ENDIF
          COEFP =FLUI(1)*FLUI(2)*FLUI(2)/FLUI(3)
          COEFPI=FLUI(1)*FLUI(3)
      ELSE
          CALL ERREUR(284)
*         IL MANQUE DES VALEURS
      ENDIF
*
*
*     NORMALISATION D'UN "CHPOINT"
      IF (IPOS .EQ. 1) THEN
         IF (INORM.EQ.1) THEN
           CALL NORMA3 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,PGRAND)
         ELSEIF (INORM.EQ.2) THEN
           CALL NORMB3(IPOINT,IRIG1,VNOR)
         ENDIF
*
*     NORMALISATION D'UNE TABLE DE SOUS TYPE "BASE_DE_MODES"
      ELSEIF (IPOS .EQ. 2) THEN
         IF (INORM.EQ.1) THEN    
            CALL NORMA5 (ITBAS,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI)
         ELSEIF (INORM.EQ.2) THEN
            CALL NORMB5(ITBAS,IRIG1,VNOR)
         ENDIF
      ENDIF
      IF (IERR .NE. 0) RETURN
 
      CALL ACTOBJ(MONTYP,IPOINT,1)
      CALL ECROBJ(MONTYP,IPOINT)
      RETURN
*
      END