Télécharger novard.eso

Retour à la liste

Numérotation des lignes :

  1. C NOVARD SOURCE CB215821 18/09/21 21:16:17 9930
  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.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43.  
  44. -INC SMLMOTS
  45. -INC SMMODEL
  46.  
  47. CHARACTER*4 CNOMV, MOT4
  48.  
  49. C* Increment sur la dimension de la liste des composantes recherchees
  50. PARAMETER ( INCJGM = 100 )
  51.  
  52. PARAMETER ( NNOMV = 14 )
  53. CHARACTER*4 LNOMV(NNOMV)
  54. DATA LNOMV / 'DEPL', 'FORC', 'GRAD', 'CONT', 'DEFO',
  55. & 'MATE', 'GEOM', 'TEMP', 'CONP', 'VARI',
  56. & 'GRAF', '....', 'DEIN', 'PARA' /
  57.  
  58. C********************* LECTURE DES DONNEES **************************
  59. MMODEL = IPO1
  60. SEGACT MMODEL
  61. NSM = KMODEL(/1)
  62.  
  63. C* JGN = 8
  64. JGN = 4
  65. JGM = INCJGM
  66. SEGINI,MLMOTS
  67.  
  68. NBCTOT = 0
  69.  
  70. DO 10 ISOUS = 1, NSM
  71. IMODEL = KMODEL(ISOUS)
  72. SEGACT IMODEL
  73. C* write(ioimp,*) ' novard lnomid',(lnomid(iou),iou=1,14)
  74. C* write(ioimp,*) ' cnomv' , cnomv
  75. CALL PLACE(LNOMV,NNOMV,iplac,CNOMV)
  76. IF (iplac.EQ.0) GOTO 11
  77. ipnomc = lnomid(iplac)
  78. C*-DEBUT ancien code
  79. C* IF(INFMOD(/1).NE.0) THEN
  80. C* NPINT=INFMOD(1)
  81. C* ELSE
  82. C* NPINT = 0
  83. C* ENDIF
  84. C* MELE = NEFMOD
  85. C* MFR = NUMMFR(MELE)
  86. C********* APPEL LE SOUS-PROGRAMME CORRESPONDANT AU MOT-CLEF *********
  87. C* GOTO (101,102,103,104,105,106,107,108,109,110,
  88. C* & 111,112,113,115),iplac
  89. C* 101 CALL IDDEPL(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  90. C* GOTO 20
  91. C* 102 CALL IDFORC(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  92. C* GOTO 20
  93. C* 103 CALL IDGRAD(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  94. C* GOTO 20
  95. C* 104 CALL IDCONT(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  96. C* GOTO 20
  97. C* 105 CALL IDDEFO(IMODEL,IFOUR,IPNOMC,NBROBL,NBRFAC)
  98. C* GOTO 20
  99. C* 106 CALL IDMATR(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  100. C* GOTO 20
  101. C* 107 CALL IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
  102. C* GOTO 20
  103. C* 108 CALL IDTEMP(MFR,IFOUR,NPINT,IPNOMC,NBROBL,NBRFAC)
  104. C* GOTO 20
  105. C* 109 CALL IDPRIN(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  106. C* GOTO 20
  107. C* 110 CALL IDVARI(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  108. C* GOTO 20
  109. C* 111 CALL IDGRAF(MFR,IFOUR,IPNOMC,NBROBL,NBRFAC)
  110. C* GOTO 20
  111. C* 112 IPNOMC=0
  112. C* GOTO 20
  113. C* 113 IPNOMC=0
  114. C* GOTO 20
  115. C* 114 CALL IDPAEX(MFR,IMODEL,IPNOMC,NBROBL,NBRFAC)
  116. C* GOTO 20
  117. C* 20 CONTINUE
  118. C*-FIN ancien code
  119. C* write(ioimp,*) ' ipnomc', ipnomc
  120. IF (ipnomc.EQ.0) GOTO 11
  121. NOMID = ipnomc
  122. SEGACT,NOMID
  123. NBROBL = lesobl(/2)
  124. NBRFAC = lesfac(/2)
  125. NBCOMP = NBROBL + NBRFAC
  126. IF (NBCOMP.EQ.0) GOTO 12
  127. JGMTOT = NBCTOT + NBCOMP
  128. IF (JGMTOT.GT.JGM) THEN
  129. JGM = ((JGMTOT / INCJGM) + 1) * INCJGM
  130. SEGADJ,MLMOTS
  131. ENDIF
  132. IF (ISOUS.EQ.1) THEN
  133. DO I = 1, NBCOMP
  134. IF (I.LE.NBROBL) THEN
  135. MOTS(NBCTOT+I) = LESOBL(I)
  136. ELSE
  137. MOTS(NBCTOT+I) = LESFAC(I-NBROBL)
  138. ENDIF
  139. ENDDO
  140. ELSE
  141. ICOMP = 0
  142. DO I = 1, NBCOMP
  143. IF (I.LE.NBROBL) THEN
  144. MOT4 = LESOBL(I)
  145. ELSE
  146. MOT4 = LESFAC(I-NBROBL)
  147. ENDIF
  148. CALL PLACE(MOTS,NBCTOT+ICOMP,iplac,MOT4)
  149. IF (iplac.EQ.0) THEN
  150. ICOMP = ICOMP + 1
  151. MOTS(NBCTOT+ICOMP) = MOT4
  152. ENDIF
  153. ENDDO
  154. JGMTOT = NBCTOT + ICOMP
  155. ENDIF
  156. NBCTOT = JGMTOT
  157. 12 CONTINUE
  158. C SEGDES,NOMID
  159. 11 CONTINUE
  160. C SEGDES,IMODEL
  161. 10 CONTINUE
  162.  
  163. C* IF (NBCTOT.EQ.0) THEN
  164. C* CALL ERREUR(643)
  165. C* SEGSUP,MLMOTS
  166. C* ELSE
  167. IF (JGM.NE.NBCTOT) THEN
  168. JGM = NBCTOT
  169. SEGADJ,MLMOTS
  170. ENDIF
  171. CALL ECROBJ('LISTMOTS',MLMOTS)
  172. SEGACT,MLMOTS
  173. C* ENDIF
  174. C SEGDES,MMODEL
  175.  
  176. RETURN
  177. END
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  

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