Télécharger tycomp.eso

Retour à la liste

Numérotation des lignes :

  1. C TYCOMP SOURCE CB215821 18/09/21 21:16:54 9930
  2.  
  3. C----------------------------------------------------------------------C
  4. C
  5. C Ce ss-programme identifie le type d'un MCHAML
  6. C associe au nom de sa composante MOT1
  7. C dans le SEGMENT NOMID du MMODEL IPMOD1
  8. C (voir notice REDU)
  9. C
  10. C Entrees :
  11. C IPMOD1 : pointeur su SEGMENT NOMID, suppose actif en entree
  12. C MOT1 : nom de composante a identifier
  13. C
  14. C Sorties :
  15. C TYPE : type du MCHAML identifie
  16. C LTYP : longueur de la chaine de caractere "TYPE"
  17. C
  18. C----------------------------------------------------------------------C
  19. SUBROUTINE TYCOMP(IPMOD1,MOT1,TYPE,LTYP)
  20.  
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. IMPLICIT INTEGER(I-N)
  23.  
  24. -INC CCOPTIO
  25. -INC SMCHAML
  26. -INC SMMODEL
  27.  
  28. PARAMETER (NMOT=12,NNOMID=14,NPAR=4)
  29. CHARACTER*(50) TYPE
  30. CHARACTER*(25) LISTIT(NMOT)
  31. INTEGER LONTIT(NMOT)
  32. CHARACTER*(8) MOCP,MOT,MOT1
  33. CHARACTER*(4) NOMPAR(NPAR)
  34. DIMENSION INOMID(NNOMID)
  35.  
  36. DATA LISTIT / 'DEPLACEMENTS', 'FORCES' , 'TEMPERATURES',
  37. & 'GRADIENT' , 'DEFORMATIONS',
  38. & 'CONTRAINTES' , 'CONTRAINTES PRINCIPALES',
  39. & 'DEFORMATIONS INELASTIQUES', 'VARIABLES INTERNES',
  40. & 'CARACTERISTIQUES','GRADIENT DE FLEXION',' '/
  41. DATA LONTIT / 12,6,12,
  42. & 8,12,
  43. & 11,23,
  44. & 25,18,
  45. & 16,19,1/
  46.  
  47. C On identifie le numero dans la liste de NOMID au type dans LISTIT
  48. * 'DEPLACEM', 'FORCES ', 'GRADIENT', 'CONTRAIN',
  49. DATA INOMID / 1 , 2 , 4 , 6 ,
  50. * 'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  51. & 5 , 10 , 10 , 3 ,
  52. * 'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL',
  53. & 7 , 9 , 11 , 12 ,
  54. * 'DEFINELA', 'PARAMEXT'/
  55. & 8 , 12/
  56. C
  57. C Cas particuliers, type : SCALAIRE...
  58. DATA NOMPAR / 'SCAL','MAHO','MIDL','SURF'/
  59. * 1 , 2 , 3 , 4 /
  60.  
  61. C Verifications elementaires
  62. C Pas de soucis pour renvoyer valeurs pas defaut
  63. IF (IPMOD1.EQ.0) RETURN
  64.  
  65. LM1 = 0
  66. DO II = 8,1,-1
  67. IF(MOT1(II:II) .NE. ' ')THEN
  68. LM1=II
  69. GOTO 100
  70. ENDIF
  71. ENDDO
  72. RETURN
  73.  
  74. 100 CONTINUE
  75.  
  76. IMODEL = IPMOD1
  77. NNO = IMODEL.LNOMID(/1)
  78. C write(6,*) 'IMODEL, NNO =',IMODEL, NNO
  79. C write(6,*) 'IMODEL.LNOMID =',(IMODEL.LNOMID(ii),ii=1,14)
  80. IF (NNO.EQ.0) RETURN
  81.  
  82. C Boucle sur les NOMID
  83.  
  84. MOCP = MOT1
  85. TYPE = ' '
  86. LTYP = 0
  87.  
  88. DO INO=1,NNO
  89. NOMID = IMODEL.LNOMID(INO)
  90. IF (NOMID.NE.0) THEN
  91. SEGACT, NOMID
  92. C
  93. nobl=nomid.lesobl(/2)
  94. DO iobl=1,nobl
  95. mot=lesobl(iobl)
  96. IF (mot(1:4).EQ.mocp(1:4)) THEN
  97. indno=INOMID(ino)
  98. type =LISTIT(indno)
  99. ltyp =LONTIT(indno)
  100. GOTO 9000
  101. ENDIF
  102. ENDDO
  103. C
  104. nfac=nomid.lesfac(/2)
  105. DO ifac=1,nfac
  106. mot=lesfac(ifac)
  107. IF (mot(1:4).EQ.mocp(1:4)) THEN
  108. indno=INOMID(ino)
  109. type=LISTIT(indno)
  110. ltyp=LONTIT(indno)
  111. GOTO 9000
  112. ENDIF
  113. ENDDO
  114. C
  115. ENDIF
  116. ENDDO
  117. 9000 CONTINUE
  118. C
  119. C Traitement des cas particuliers :
  120. C
  121. if (ltyp.eq.0) then
  122. CALL PLACE(NOMPAR,NPAR,JSP,MOCP(1:4))
  123. IF (IERR.NE.0) RETURN
  124. C
  125. C 1/ Type SCALAIRE : mocp = 'SCAL'
  126. C
  127. IF (JSP.EQ.1) THEN
  128. type='SCALAIRE'
  129. ltyp=8
  130.  
  131. C 2/ Type MATRICE DE HOOKE : mocp = 'MAHO'
  132. C
  133. ELSEIF (JSP.EQ.2) THEN
  134. type='MATRICE DE HOOKE'
  135. ltyp=16
  136.  
  137. C 3/ Type MATRICE DE RAYONNEMENT : mocp = 'MIDL' ou 'SURF'
  138. C
  139. ELSEIF (JSP.EQ.3.OR.JSP.EQ.4) THEN
  140. type='MATRICE DE RAYONNEMENT'
  141. ltyp=22
  142. ENDIF
  143.  
  144. endif
  145.  
  146. END
  147.  
  148.  
  149.  

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