Download prmu.eso

Back to the list

   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 : -INC CCOPTIO
  12 : *- 
  13 : -INC SMTABLE
  14 :       CHARACTER*8 TYPRET
  15 : 
  16 :       ijwi = 0
  16 :         CALL ACCTAB(ITBST,'MOT',I0,X0,'SOUSTYPE',L0,IP0, 
  17 :      &                  'MOT',I1,X1,mwi,L1,ITDEPL)
  18 :       if (mwi(1:13).eq.'BASE_DE_MODES') ijwi = 1
  19 : 
  20 :       mtable = itbst 
  21 :       segact mtable 
  22 : 
  23 :       IM = 0 
  24 :       IMA = 0                                        
  25 :  50   CONTINUE                  
  26 :       IM = IM + 1
  27 :       itmod = mtabiv(im)
  28 :       typret = mtabtv(im)
  29 :       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN 
  30 :         ITAB2=itmod
  31 :         if (ijwi.eq.1) then
  31 :         CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, 
  32 :      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  33 :         else   
  33 :         CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0, 
  34 :      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  35 :         endif
  35 :          call MUCPRI(itdepl,irig,ire1)
  36 :          if (ierr.ne.0) return
  36 :          CALL ECCTAB(ITAB2,'MOT',0,0.0D0,'MASSE_DEFORMEE',.TRUE.,0,
  37 :      &        'CHPOINT ',0,0.0d0,' ',.TRUE.,ire1)       
  38 :       ENDIF
  39 :       if (im.lt.mlotab) goto 50
  40 :       segdes mtable
  41 :       return
  42 : 
  43 :       END
  44 :  
  45 :  
  46 :  

© Cast3M 2003 - All rights reserved.
Disclaimer