Download novard.eso

Back to the list

   1 : C NOVARD    SOURCE    CHAT      11/03/16    21:28:40     6902           
   2 :         SUBROUTINE NOVARD(IPO1,CNOMV)
   3 : 
   4 : C************************************************************************
   5 : C                                                                       *
   6 : C               RECHERCHE DES NOMS DE COMPOSANTES                       *
   7 : C               ---------------------------------                       *
   8 : C                                                                       *
   9 : C    OBJET3 = NOVARD OBJET1 OBJET2                                      *
  10 : C                                                                       *
  11 : C        OBJET1:   TYPE MODELE                                          *
  12 : C        OBJET2:   TYPE CHARACTER*4                                     *
  13 : C                                                                       *
  14 : C        OBJET3:   TYPE LISTE DE MOTS                                   *
  15 : C                                                                       *
  16 : C    L'objet 2 définit le type de variables dont on veut connaître      *
  17 : C      le nom des composantes.Il existe 11 mots clefs différents:       *
  18 : C                                                                       *
  19 : C        GEOM : Nom des composantes des caractéristiques géométriques   *
  20 : C        CONT : Nom des composantes de contraintes                      *
  21 : C        DEFO : Nom des composantes de deformation                      *
  22 : C        DEPL : Nom des composantes de déplacement                      *
  23 : C        FORC : Nom des composantes de force                            *
  24 : C        GRAD : Nom des composantes de gradient                         *
  25 : C        GRAF : Nom des composantes de gradient en flexion              *
  26 : C        MATE : Nom des composantes de matériau                         *
  27 : C        CONP : Nom des composantes des contraintes principales         *
  28 : C        TEMP : Nom des composantes de température                      *
  29 : C        VARI : Nom des composantes de variable interne                 *
  30 : C                                                                       *
  31 : C    REMARQUE : Les noms des composantes de vitesse et de matériau en   *
  32 : C        thermique ne sont pas disponibles:en effet les sous-programmes *
  33 : C        IDMAT1 et IDVITE n'existent plus!                              *
  34 : C                                                                       *
  35 : C************************************************************************
  36 : 
  37 :       IMPLICIT INTEGER(I-N)
  38 :       IMPLICIT REAL*8(A-H,O-Z)
  39 : 
  40 : -INC CCOPTIO
  41 : 
  42 : -INC SMLMOTS
  43 : -INC SMMODEL
  44 : 
  45 :         CHARACTER*4 CNOMV, MOT4
  46 : 
  47 : C* Increment sur la dimension de la liste des composantes recherchees
  48 :        PARAMETER ( INCJGM = 100 )
  49 : 
  50 :        PARAMETER ( NNOMV = 14 )
  51 :        CHARACTER*4 LNOMV(NNOMV)
  52 :        DATA LNOMV / 'DEPL', 'FORC', 'GRAD', 'CONT', 'DEFO',
  53 :      &              'MATE', 'GEOM', 'TEMP', 'CONP', 'VARI',
  54 :      &              'GRAF', '....', 'DEIN', 'PARA' /
  55 : 
  56 : C*********************   LECTURE DES DONNEES   **************************
  57 :         MMODEL = IPO1
  58 :         SEGACT MMODEL
  59 :         NSM = KMODEL(/1)
  60 : 
  61 : C*      JGN = 8
  62 :         JGN = 4
  63 :         JGM = INCJGM
  64 :         SEGINI,MLMOTS
  65 : 
  66 :         NBCTOT = 0
  67 : 
  68 :         DO 10 ISOUS = 1, NSM
  69 :           IMODEL = KMODEL(ISOUS)
  70 :           SEGACT IMODEL
  71 : C*          write(ioimp,*) ' novard lnomid',(lnomid(iou),iou=1,14)
  72 : C*          write(ioimp,*) ' cnomv' , cnomv
  72 :           CALL PLACE(LNOMV,NNOMV,iplac,CNOMV)
  73 :           IF (iplac.EQ.0) GOTO 11
  74 :           ipnomc = lnomid(iplac)
  75 : C*-DEBUT ancien code
  76 : C*          IF(INFMOD(/1).NE.0)  THEN
  77 : C*            NPINT=INFMOD(1)   
  78 : C*          ELSE
  79 : C*            NPINT = 0
  80 : C*          ENDIF    
  81 : C*          MELE = NEFMOD
  82 : C*          MFR = NUMMFR(MELE)
  83 : C*********  APPEL LE SOUS-PROGRAMME CORRESPONDANT AU MOT-CLEF   *********
  84 : C*          GOTO (101,102,103,104,105,106,107,108,109,110,
  85 : C*     &          111,112,113,115),iplac
  85 : C* 101      CALL IDDEPL(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  86 : C*          GOTO 20
  86 : C* 102      CALL IDFORC(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  87 : C*          GOTO 20
  87 : C* 103      CALL IDGRAD(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  88 : C*          GOTO 20
  88 : C* 104      CALL IDCONT(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  89 : C*          GOTO 20
  89 : C* 105      CALL IDDEFO(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  90 : C*          GOTO 20
  90 : C* 106      CALL IDMATR(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  91 : C*          GOTO 20
  91 : C* 107      CALL IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
  92 : C*          GOTO 20
  92 : C* 108      CALL IDTEMP(MFR,IFOUR,NPINT,IPNOMC,NBROBL,NBRFAC)
  93 : C*          GOTO 20
  93 : C* 109      CALL IDPRIN(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  94 : C*          GOTO 20
  94 : C* 110      CALL IDVARI(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  95 : C*          GOTO 20
  95 : C* 111      CALL IDGRAF(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  96 : C*          GOTO 20
  97 : C* 112      IPNOMC=0
  98 : C*          GOTO 20
  99 : C* 113      IPNOMC=0
 100 : C*          GOTO 20
 100 : C* 114      CALL IDPAEX(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
 101 : C*          GOTO 20
 102 : C* 20       CONTINUE
 103 : C*-FIN ancien code
 104 : C*          write(ioimp,*) ' ipnomc', ipnomc
 105 :           IF (ipnomc.EQ.0) GOTO 11
 106 :           NOMID = ipnomc
 107 :           SEGACT,NOMID
 108 :           NBROBL = lesobl(/2)
 109 :           NBRFAC = lesfac(/2)
 110 :           NBCOMP = NBROBL + NBRFAC
 111 :           IF (NBCOMP.EQ.0) GOTO 12
 112 :           JGMTOT = NBCTOT + NBCOMP
 113 :           IF (JGMTOT.GT.JGM) THEN
 114 :             JGM = ((JGMTOT / INCJGM) + 1) * INCJGM
 115 :             SEGADJ,MLMOTS
 116 :           ENDIF
 117 :           IF (ISOUS.EQ.1) THEN
 118 :             DO I = 1, NBCOMP
 119 :               IF (I.LE.NBROBL) THEN
 120 :                 MOTS(NBCTOT+I) = LESOBL(I)
 121 :               ELSE
 122 :                 MOTS(NBCTOT+I) = LESFAC(I-NBROBL)
 123 :               ENDIF
 124 :             ENDDO
 125 :           ELSE
 126 :             ICOMP = 0
 127 :             DO I = 1, NBCOMP
 128 :               IF (I.LE.NBROBL) THEN
 129 :                 MOT4 = LESOBL(I)
 130 :               ELSE
 131 :                 MOT4 = LESFAC(I-NBROBL)
 132 :               ENDIF
 132 :               CALL PLACE(MOTS,NBCTOT+ICOMP,iplac,MOT4)
 133 :               IF (iplac.EQ.0) THEN
 134 :                 ICOMP = ICOMP + 1
 135 :                 MOTS(NBCTOT+ICOMP) = MOT4
 136 :               ENDIF
 137 :             ENDDO
 138 :             JGMTOT = NBCTOT + ICOMP
 139 :           ENDIF
 140 :           NBCTOT = JGMTOT
 141 :  12       CONTINUE
 142 :           SEGDES,NOMID
 143 :  11       CONTINUE
 144 :           SEGDES,IMODEL
 145 :  10     CONTINUE
 146 : 
 147 : C*      IF (NBCTOT.EQ.0) THEN
 147 : C*        CALL ERREUR(643)
 148 : C*        SEGSUP,MLMOTS
 149 : C*      ELSE
 150 :           IF (JGM.NE.NBCTOT) THEN
 151 :             JGM = NBCTOT
 152 :             SEGADJ,MLMOTS
 153 :           ENDIF
 153 :           CALL ECROBJ('LISTMOTS',MLMOTS)
 154 :           SEGDES,MLMOTS
 155 : C*      ENDIF
 156 :         SEGDES,MMODEL
 157 : 
 158 :         RETURN
 159 :         END
 160 : 
 161 :  
 162 :  
 163 :  

© Cast3M 2003 - All rights reserved.
Disclaimer