Télécharger la plaquette Cast3M


fr en

Télécharger ricro1.eso

Retour à la liste

Numérotation des lignes : 

ricro1

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

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