Télécharger novard.eso

Retour à la liste

Numérotation des lignes :

  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
  73. CALL PLACE(LNOMV,NNOMV,iplac,CNOMV)
  74. IF (iplac.EQ.0) GOTO 11
  75. ipnomc = lnomid(iplac)
  76. C*-DEBUT ancien code
  77. C* IF(INFMOD(/1).NE.0) THEN
  78. C* NPINT=INFMOD(1)
  79. C* ELSE
  80. C* NPINT = 0
  81. C* ENDIF
  82. C* MELE = NEFMOD
  83. C* MFR = NUMMFR(MELE)
  84. C********* APPEL LE SOUS-PROGRAMME CORRESPONDANT AU MOT-CLEF *********
  85. C* GOTO (101,102,103,104,105,106,107,108,109,110,
  86. C* & 111,112,113,115),iplac
  87. C* 101 CALL IDDEPL(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  88. C* GOTO 20
  89. C* 102 CALL IDFORC(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  90. C* GOTO 20
  91. C* 103 CALL IDGRAD(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  92. C* GOTO 20
  93. C* 104 CALL IDCONT(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  94. C* GOTO 20
  95. C* 105 CALL IDDEFO(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  96. C* GOTO 20
  97. C* 106 CALL IDMATR(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  98. C* GOTO 20
  99. C* 107 CALL IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
  100. C* GOTO 20
  101. C* 108 CALL IDTEMP(MFR,IFOUR,NPINT,IPNOMC,NBROBL,NBRFAC)
  102. C* GOTO 20
  103. C* 109 CALL IDPRIN(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  104. C* GOTO 20
  105. C* 110 CALL IDVARI(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  106. C* GOTO 20
  107. C* 111 CALL IDGRAF(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  108. C* GOTO 20
  109. C* 112 IPNOMC=0
  110. C* GOTO 20
  111. C* 113 IPNOMC=0
  112. C* GOTO 20
  113. C* 114 CALL IDPAEX(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  114. C* GOTO 20
  115. C* 20 CONTINUE
  116. C*-FIN ancien code
  117. C* write(ioimp,*) ' ipnomc', ipnomc
  118. IF (ipnomc.EQ.0) GOTO 11
  119. NOMID = ipnomc
  120. SEGACT,NOMID
  121. NBROBL = lesobl(/2)
  122. NBRFAC = lesfac(/2)
  123. NBCOMP = NBROBL + NBRFAC
  124. IF (NBCOMP.EQ.0) GOTO 12
  125. JGMTOT = NBCTOT + NBCOMP
  126. IF (JGMTOT.GT.JGM) THEN
  127. JGM = ((JGMTOT / INCJGM) + 1) * INCJGM
  128. SEGADJ,MLMOTS
  129. ENDIF
  130. IF (ISOUS.EQ.1) THEN
  131. DO I = 1, NBCOMP
  132. IF (I.LE.NBROBL) THEN
  133. MOTS(NBCTOT+I) = LESOBL(I)
  134. ELSE
  135. MOTS(NBCTOT+I) = LESFAC(I-NBROBL)
  136. ENDIF
  137. ENDDO
  138. ELSE
  139. ICOMP = 0
  140. DO I = 1, NBCOMP
  141. IF (I.LE.NBROBL) THEN
  142. MOT4 = LESOBL(I)
  143. ELSE
  144. MOT4 = LESFAC(I-NBROBL)
  145. ENDIF
  146. CALL PLACE(MOTS,NBCTOT+ICOMP,iplac,MOT4)
  147. IF (iplac.EQ.0) THEN
  148. ICOMP = ICOMP + 1
  149. MOTS(NBCTOT+ICOMP) = MOT4
  150. ENDIF
  151. ENDDO
  152. JGMTOT = NBCTOT + ICOMP
  153. ENDIF
  154. NBCTOT = JGMTOT
  155. 12 CONTINUE
  156. SEGDES,NOMID
  157. 11 CONTINUE
  158. SEGDES,IMODEL
  159. 10 CONTINUE
  160.  
  161. C* IF (NBCTOT.EQ.0) THEN
  162. C* CALL ERREUR(643)
  163. C* SEGSUP,MLMOTS
  164. C* ELSE
  165. IF (JGM.NE.NBCTOT) THEN
  166. JGM = NBCTOT
  167. SEGADJ,MLMOTS
  168. ENDIF
  169. CALL ECROBJ('LISTMOTS',MLMOTS)
  170. SEGDES,MLMOTS
  171. C* ENDIF
  172. SEGDES,MMODEL
  173.  
  174. RETURN
  175. END
  176.  
  177.  
  178.  
  179.  
  180.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales