Télécharger prmu.eso

Retour à la liste

Numérotation des lignes :

  1. C PRMU SOURCE KICH 11/01/07 21:16:12 6839
  2. SUBROUTINE PRMU(IRIG,ITBST)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. logical l0,l1
  6. CHARACTER*16 mwi
  7. *--------------------------------------------------------------------*
  8. * calcul MU pour les solutions statiques et range dans la table
  9. *--------------------------------------------------------------------*
  10. * *
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. *-
  15. -INC SMTABLE
  16. CHARACTER*8 TYPRET
  17.  
  18. ijwi = 0
  19. CALL ACCTAB(ITBST,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  20. & 'MOT',I1,X1,mwi,L1,ITDEPL)
  21. if (mwi(1:13).eq.'BASE_DE_MODES') ijwi = 1
  22.  
  23. mtable = itbst
  24. segact mtable
  25.  
  26. IM = 0
  27. IMA = 0
  28. 50 CONTINUE
  29. IM = IM + 1
  30. itmod = mtabiv(im)
  31. typret = mtabtv(im)
  32. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  33. ITAB2=itmod
  34. if (ijwi.eq.1) then
  35. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  36. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  37. else
  38. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  39. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  40. endif
  41. call MUCPRI(itdepl,irig,ire1)
  42. if (ierr.ne.0) return
  43. CALL ECCTAB(ITAB2,'MOT',0,0.0D0,'MASSE_DEFORMEE',.TRUE.,0,
  44. & 'CHPOINT ',0,0.0d0,' ',.TRUE.,ire1)
  45. ENDIF
  46. if (im.lt.mlotab) goto 50
  47. segdes mtable
  48. return
  49.  
  50. END
  51.  
  52.  
  53.  
  54.  

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