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