Télécharger ricro1.eso

Retour à la liste

Numérotation des lignes :

  1. C RICRO1 SOURCE CB215821 16/04/21 21:18:18 8920
  2. SUBROUTINE RICRO1(ipv1,ipv2,ibu,ibd,mot2,irig,iinc,idua,xr1)
  3. * produit scalaire proprement dit
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC SMCHAML
  7. -INC SMLMOTS
  8. c
  9. SEGMENT MPTVAL
  10. INTEGER IPOS(NS),NSOF(NS)
  11. INTEGER IVAL(NCOSOU)
  12. CHARACTER*16 TYVAL(NCOSOU)
  13. ENDSEGMENT
  14. C
  15. CHARACTER*4 mot2
  16.  
  17. xr1 = 0.d0
  18. mptval = ipv1
  19. segact mptval
  20. if (irig.eq.1) then
  21. *masse
  22. melval = ival(3)
  23. segact melval
  24. IBMN=MIN(IBU,IELCHE(/2))
  25. itreac = ielche(1,ibmn)
  26. segdes melval
  27. elseif (irig.eq.2) then
  28. * rigidite
  29. melval = ival(2)
  30. segact melval
  31. IBMN=MIN(IBU,IELCHE(/2))
  32. itreac = ielche(1,ibmn)
  33. segdes melval
  34. *
  35. elseif (irig.eq.3) then
  36. xamorsta = 0.
  37. if(ival(/1).gt.3) then
  38. melval = ival(4)
  39. if (melval.gt.0) then
  40. segact melval
  41. IBMN=MIN(IBU,VELCHE(/2))
  42. xamorsta = velche(1,ibmn)
  43. segdes melval
  44. *comme pour masse
  45. melval = ival(3)
  46. segact melval
  47. IBMN=MIN(IBU,IELCHE(/2))
  48. itreac = ielche(1,ibmn)
  49. segdes melval
  50. endif
  51. endif
  52. *
  53. endif
  54.  
  55. if (ipv1.ne.ipv2) then
  56. segdes mptval
  57. mptval = ipv2
  58. segact mptval
  59. endif
  60.  
  61. *masse ou rigidite
  62. if (mot2.eq.'STAT') then
  63. melval = ival(1)
  64. elseif (mot2.eq.'MODA') then
  65. melval = ival(3)
  66. endif
  67. segact melval
  68. IBMN=MIN(IBD,IELCHE(/2))
  69. itdepl = ielche(1,ibmn)
  70. segdes melval
  71. *
  72. if (irig.eq.3) then
  73. xamo2 = 0.
  74. if(ival(/1).gt.3) then
  75. melval = ival(4)
  76. if (melval.gt.0) then
  77. segact melval
  78. IBMN=MIN(IBD,VELCHE(/2))
  79. xamo2 = velche(1,ibmn)
  80. segdes melval
  81. endif
  82. endif
  83. xamo3 = xamorsta*xamo2
  84. if (xamo3.eq.0.) then
  85. xr1 = 0.
  86. return
  87. else
  88. xamo = SQRT(ABS(xamo3))
  89. if (xamo3.lt.0) xamo = xamo * (-1.d0)
  90. endif
  91. endif
  92.  
  93.  
  94.  
  95. CALL XTY1(itdepl,itreac,iinc,idua,XR1)
  96. if (ierr.ne.0) return
  97. if (irig.eq.3) xr1 = xr1 * xamo
  98.  
  99. RETURN
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  

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