Télécharger la plaquette Cast3M


fr en

Télécharger force2.eso

Retour à la liste

Numérotation des lignes : 

force2

  1. C FORCE2    SOURCE    CB215821  16/04/15    21:15:25     8907
  2.       SUBROUTINE FORCE2(IPT)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMTABLE
  10.       CHARACTER*4 MOTYPO(10),charm,charre
  11.       character*8 typret
  12.       CHARACTER*4 MODEDU(6),MORODU(5)
  13.       REAL*8 XXA,vval,X0,X1
  14.       DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
  15.       DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /
  16.  
  17.       IPO=0
  18.  
  19.       mtable = ipt
  20.       segact mtable
  21.       ima = mlotab - 1
  22.       if (ima.eq.1) RETURN
  23.       do 1200 im = 1,ima
  24.            typret = ' '
  25.            CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0,
  26.      &                   'TABLE',I1,X1,CHARRE,.true.,ITMOD)
  27.            if (ierr.ne.0) return
  28.            CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0,
  29.      &                      typret,I1,X1,charre,.true.,IR1)
  30.            if (typret.ne.'MOT') goto 1200
  31.            do kmo = 1,6
  32.             if (charre.eq.modedu(kmo)) goto 220
  33.            enddo
  34.            do kmo = 1,5
  35.             if (charre.eq.morodu(kmo)) goto 220
  36.            enddo
  37. cc           write(6,*)  charre,' ne correspond pas à un effort'
  38.            goto 1200
  39.  220       continue
  40.            CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
  41.      &                      'POINT',I1,X1,charre,.true.,IPTS)
  42.            if (ierr.ne.0) return
  43.  
  44.  
  45.            if (ierr.ne.0) return
  46. *
  47.          call ecrobj('POINT',IPTS)
  48.          call ecrree(1.d0)
  49.          call ecrcha(charre)
  50.          call force(1)
  51.          call lirobj('CHPOINT',ichpoi,1, iretou)
  52.          if (ierr.ne.0) return
  53.  
  54.            CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'FORCE',.TRUE.,IPO,
  55.      &        'CHPOINT',0,0.0D0,' ',.TRUE.,ichpoi)
  56.  
  57.  1200 continue
  58.       segdes mtable
  59.       return
  60.       END
  61.  
  62.  
  63.  

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