Télécharger force2.eso

Retour à la liste

Numérotation des lignes :

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

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