Sources Esope | Cast3M

novard
C NOVARD    SOURCE    OF166741  24/10/07    21:15:38     12016          
        SUBROUTINE NOVARD(IPO1,CNOMV)
 
C************************************************************************
C                                                                       *
C               RECHERCHE DES NOMS DE | COMPOSANTES                     *
C                                  DE | PHASES                          *
C               -----------------------------------                     *
C                                                                       *
C    OBJET3 = NOVARD OBJET1 OBJET2                                      *
C                                                                       *
C        OBJET1:   TYPE MODELE                                          *
C        OBJET2:   TYPE CHARACTER*4                                     *
C                                                                       *
C        OBJET3:   TYPE LISTE DE MOTS                                   *
C                                                                       *
C    L'objet 2 définit le type de variables dont on veut connaître      *
C      le nom des composantes.Il existe 11 mots clefs différents:       *
C                                                                       *
C        GEOM : Nom des composantes des caractéristiques géométriques   *
C        CONT : Nom des composantes de contraintes                      *
C        DEFO : Nom des composantes de deformation                      *
C        DEPL : Nom des composantes de déplacement                      *
C        FORC : Nom des composantes de force                            *
C        GRAD : Nom des composantes de gradient                         *
C        GRAF : Nom des composantes de gradient en flexion              *
C        MATE : Nom des composantes de matériau                         *
C        CONP : Nom des composantes des contraintes principales         *
C        TEMP : Nom des composantes de température                      *
C        VARI : Nom des composantes de variable interne                 *
C                                                                       *
C    REMARQUE : Les noms des composantes de vitesse et de matériau en   *
C        thermique ne sont pas disponibles:en effet les sous-programmes *
C        IDMAT1 et IDVITE n'existent plus!                              *
C                                                                       *
C************************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMLMOTS
-INC SMMODEL
 
       CHARACTER*(*)      CNOMV
       CHARACTER*(LOCOMP) CNOMW
       CHARACTER*(LCONMO) CONS1
 
C* Increment sur la dimension de la liste des composantes recherchees
       PARAMETER ( INCJGM = 100 )
 
       PARAMETER ( NNOMV = 15 )
       CHARACTER*4 LNOMV(NNOMV)
       DATA LNOMV / 'DEPL', 'FORC', 'GRAD', 'CONT', 'DEFO',
     &              'MATE', 'GEOM', 'TEMP', 'CONP', 'VARI',
     &              'GRAF', '....', 'DEIN', 'PARA', 'PHAS' /
 
C*********************   LECTURE DES DONNEES   **************************
        MMODEL = IPO1
        NSM    = KMODEL(/1)
 
        JGN    = LOCOMP
        JGM    = INCJGM
        SEGINI,MLMOTS
 
        NBCTOT = 0
 
        DO 10 ISOUS = 1, NSM
          IMODEL = KMODEL(ISOUS)
C*          write(ioimp,*) ' novard lnomid',(lnomid(iou),iou=1,14)
C*          write(ioimp,*) ' cnomv' , cnomv
 
          CALL PLACE(LNOMV,NNOMV,iplac,CNOMV)
          IF (iplac.EQ.0 ) GOTO 11
          IF (iplac.EQ.15) THEN
            CONS1=CONMOD
            IF(CONS1(17:24).EQ.'        ') GOTO 11
            IF(NBCTOT.EQ.0) THEN
              NBCTOT=NBCTOT+1
              MOTS(NBCTOT) = CONS1(17:24)
            ELSE
              CALL PLACE(MOTS,NBCTOT,iplac2,CONS1(17:24))
              IF (iplac2.EQ.0) THEN
                NBCTOT=NBCTOT+1
                IF(NBCTOT.GT.JGM) THEN
                  JGM=JGM+INCJGM
                  SEGADJ,MLMOTS
                ENDIF
                MOTS(NBCTOT) = CONS1(17:24)
              ENDIF
            ENDIF
 
          ELSE
          ipnomc = lnomid(iplac)
C*-DEBUT ancien code
C*          NPINT=INFMOD(1)
C*          MELE = NEFMOD
C*          MFR = NUMMFR(MELE)
C*********  APPEL LE SOUS-PROGRAMME CORRESPONDANT AU MOT-CLEF   *********
C*          GOTO (101,102,103,104,105,106,107,108,109,110,
C*     &          111,112,113,115),iplac
C* 101      CALL IDDEPL(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 102      CALL IDFORC(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 103      CALL IDGRAD(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 104      CALL IDCONT(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 105      CALL IDDEFO(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 106      CALL IDMATR(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 107      CALL IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 108      CALL IDTEMP(MFR,IFOUR,NPINT,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 109      CALL IDPRIN(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 110      CALL IDVARI(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 111      CALL IDGRAF(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 112      IPNOMC=0
C*          GOTO 20
C* 113      IPNOMC=0
C*          GOTO 20
C* 114      CALL IDPAEX(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
C*          GOTO 20
C* 20       CONTINUE
C*-FIN ancien code
C*          write(ioimp,*) ' ipnomc', ipnomc
          IF (ipnomc.EQ.0) GOTO 11
          NOMID = ipnomc
          NBROBL = lesobl(/2)
          NBRFAC = lesfac(/2)
          NBCOMP = NBROBL + NBRFAC
          IF (NBCOMP.EQ.0) GOTO 12
          JGMTOT = NBCTOT + NBCOMP
          IF (JGMTOT.GT.JGM) THEN
            JGM = ((JGMTOT / INCJGM) + 1) * INCJGM
            SEGADJ,MLMOTS
          ENDIF
          IF (ISOUS.EQ.1) THEN
            DO I = 1, NBCOMP
              IF (I.LE.NBROBL) THEN
                MOTS(NBCTOT+I) = LESOBL(I)
              ELSE
                MOTS(NBCTOT+I) = LESFAC(I-NBROBL)
              ENDIF
            ENDDO
          ELSE
            ICOMP = 0
            DO I = 1, NBCOMP
              IF (I.LE.NBROBL) THEN
                CNOMW = LESOBL(I)
              ELSE
                CNOMW = LESFAC(I-NBROBL)
              ENDIF
              CALL PLACE(MOTS,NBCTOT+ICOMP,iplac,CNOMW)
              IF (iplac.EQ.0) THEN
                ICOMP = ICOMP + 1
                MOTS(NBCTOT+ICOMP) = CNOMW
              ENDIF
            ENDDO
            JGMTOT = NBCTOT + ICOMP
          ENDIF
          NBCTOT = JGMTOT
 12       CONTINUE
          ENDIF
 
 11       CONTINUE
 10     CONTINUE
 
C*      IF (NBCTOT.EQ.0) THEN
C*        CALL ERREUR(643)
C*        SEGSUP,MLMOTS
C*      ELSE
          IF (JGM.NE.NBCTOT) THEN
            JGM = NBCTOT
            SEGADJ,MLMOTS
          ENDIF
          SEGACT,MLMOTS
          CALL ECROBJ('LISTMOTS',MLMOTS)
C*      ENDIF
 
        RETURN
        END