Télécharger la plaquette Cast3M


fr en

Télécharger prmu.eso

Retour à la liste

Numérotation des lignes : 

prmu

  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