Download depim2.eso

Back to the list

   1 : C DEPIM2    SOURCE    KICH      08/07/30    21:15:00     6140           
   2 :       SUBROUTINE DEPIM2(IPT)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       CHARACTER*4 charm,charre
   5 :       REAL*8 XXA,vval,X0,X1
   6 : -INC CCOPTIO
   7 : -INC SMTABLE
   8 : 
   9 :       mtable = ipt
  10 :       segact mtable
  11 :       ima = mlotab - 1 
  12 : c     if (ima.eq.1) RETURN 
  13 : 
  14 :       do 1200 im = 1,ima
  14 :            CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
  15 :      &                   'TABLE',I1,X1,CHARRE,.true.,ITMOD)
  16 :            if (ierr.ne.0) return
  16 :            CALL ACCTAB(ITMOD,'MOT',I0,X0,'BLOCAGE',.true.,IP0,
  17 :      &                      'RIGIDITE',I1,X1,charre,.true.,IR1)
  18 :            if (ir1.lt.0) goto 1200
  19 :            if (ierr.ne.0) return
  20 : *
  20 :          call ecrree(1.d0)
  20 :          call ecrobj('RIGIDITE',ir1)
  20 :          call depimp
  20 :          call lirobj('CHPOINT',ichpoi,1, iretou)
  21 :          if (ierr.ne.0) return
  22 : 
  22 :            CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'FORCE',.TRUE.,IPO,
  23 :      &        'CHPOINT',0,0.0D0,' ',.TRUE.,ichpoi)
  24 : 
  25 :  1200 continue
  26 : c
  27 : c
  28 :       RETURN
  29 :       END
  30 :  
  31 :  

© Cast3M 2003 - All rights reserved.
Disclaimer