Télécharger la plaquette Cast3M


fr en

Télécharger force.eso

Retour à la liste

Numérotation des lignes : 

force

  1. C FORCE     SOURCE    FANDEUR   22/01/03    21:15:17     11136          
  2.  
  3. C=======================================================================
  4. C=          OPERATEUR FORCE OU MOMENT
  5. C
  6. C=             SYNTAXE CHP1=FORCE  I    VECTEUR          I  OBJET ;
  7. C=                                 I  NOMFORC  VAL  ...  I
  8. C
  9. C=                     CHP2=MOMEN  I    VECTEUR          I  OBJET ;
  10. C=                                 I  NOMMOME  VAL  ...  I
  11. C
  12. C=                           VECTEUR EST LE VECTEUR FORCE TOTAL APPLIQUE
  13. C=                                    A L OBJET QUI PEUT ETRE UNE LISTE
  14. C=                                    DE POINTS OU D ELEMENTS
  15. C=======================================================================
  16.  
  17.       SUBROUTINE FORCE(LTYP)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMELEME
  26. -INC SMCHPOI
  27. -INC SMCOORD
  28.  
  29.       SEGMENT MSWMOT
  30.         CHARACTER*(LOCOMP) MOTFOR(0)
  31.       ENDSEGMENT
  32.       SEGMENT MSWVAL
  33.         REAL*8 VALFOR(0)
  34.       ENDSEGMENT
  35.  
  36.       DIMENSION VEC(3)
  37.       CHARACTER*4 MOFOR1(2),MOFOR2(2),MOFOR3(3),MOFOR4(3),MOFOR5(2)
  38.       CHARACTER*4 MOTYPO(10)
  39.       CHARACTER*4 MOMOM1(1),MOMOM2(1),MOMOM3(2),MOMOM4(3)
  40.       REAL*8 XXA,vval,X0,X1
  41.  
  42.  
  43.       DATA MOTYPO / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ',
  44.      .              'MX  ','MY  ','MZ  ','MT  ' /
  45.       DATA MOFOR1 / 'FX  ','FY  ' /
  46.       DATA MOFOR2 / 'FR  ','FZ  ' /
  47.       DATA MOFOR3 / 'FR  ','FZ  ','FT  ' /
  48.       DATA MOFOR4 / 'FX  ','FY  ','FZ  ' /
  49.       DATA MOFOR5 / 'FX  ','FZ  ' /
  50.       DATA MOMOM1 / 'MZ  ' /
  51.       DATA MOMOM2 / 'MT  ' /
  52.       DATA MOMOM3 / 'MT  ','MZ  ' /
  53.       DATA MOMOM4 / 'MX  ','MY  ','MZ  ' /
  54.  
  55.  
  56.       call lirtab('LIAISONS_STATIQUES',ipt,0,iret1)
  57.       if (iret1.ne.0) goto 200
  58.  
  59. CCCCCCCCCC ON LIT SOIT UN VECTEUR , SOIT UN OU PLUSIEURS NOMS DE
  60. C    COMPOSANTES ACCOMPAGNES D'UN FLOTTANT
  61.  
  62.       CALL LIROBJ('POINT   ',NOEUD,0,IRET1)
  63.       IF (IRET1.EQ.0) THEN
  64.         SEGINI,MSWMOT,MSWVAL
  65.         IF (LTYP.EQ.1) THEN
  66.           IF (IFOMOD.EQ.-1) THEN
  67. C  ON INTRODUIT LES FORCES EN DEFO PLANE GENE (FX,FY,FZ)
  68.  11         IF (IFOUR.EQ.-3) THEN
  69.               CALL LIRMOT(MOFOR4,3,IMLU,0)
  70.               IF (IMLU.EQ.0) GOTO 999
  71.               CALL LIRREE(VAL,1,IRETOU)
  72.               IF (IERR.NE.0) RETURN
  73.               MOTFOR(**)=MOFOR4(IMLU)
  74.               VALFOR(**)=VAL
  75.             ELSE
  76.               CALL LIRMOT(MOFOR1,2,IMLU,0)
  77.               IF (IMLU.EQ.0) GOTO 999
  78.               CALL LIRREE(VAL,1,IRETOU)
  79.               IF (IERR.NE.0) RETURN
  80.               MOTFOR(**)=MOFOR1(IMLU)
  81.               VALFOR(**)=VAL
  82.             ENDIF
  83.             GOTO 11
  84.           ELSE IF(IFOMOD.EQ.0) THEN
  85.  12         CALL LIRMOT(MOFOR2,2,IMLU,0)
  86.             IF (IMLU.EQ.0) GOTO 999
  87.             CALL LIRREE(VAL,1,IRETOU)
  88.             IF (IERR.NE.0) RETURN
  89.             MOTFOR(**)=MOFOR2(IMLU)
  90.             VALFOR(**)=VAL
  91.             GOTO 12
  92.           ELSE IF (IFOMOD.EQ.1) THEN
  93.  13         CALL LIRMOT(MOFOR3,3,IMLU,0)
  94.             IF (IMLU.EQ.0) GOTO 999
  95.             CALL LIRREE(VAL,1,IRETOU)
  96.             IF (IERR.NE.0) RETURN
  97.             MOTFOR(**)=MOFOR3(IMLU)
  98.             VALFOR(**)=VAL
  99.             GOTO 13
  100.           ELSE IF (IFOMOD.EQ.2) THEN
  101.  14         CALL LIRMOT(MOFOR4,3,IMLU,0)
  102.             IF (IMLU.EQ.0) GOTO 999
  103.             CALL LIRREE(VAL,1,IRETOU)
  104.             IF (IERR.NE.0) RETURN
  105.             MOTFOR(**)=MOFOR4(IMLU)
  106.             VALFOR(**)=VAL
  107.             GOTO 14
  108.           ELSE IF (IFOMOD.EQ.3) THEN
  109.             IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) THEN
  110.  151          CALL LIRMOT(MOFOR5,2,IMLU,0)
  111.               IF (IMLU.EQ.0) GOTO 999
  112.               CALL LIRREE(VAL,1,IRETOU)
  113.               IF (IERR.NE.0) RETURN
  114.               MOTFOR(**)=MOFOR5(IMLU)
  115.               VALFOR(**)=VAL
  116.               GOTO 151
  117.             ELSE
  118.               NC=1
  119.               IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) NC=2
  120.               IF (IFOUR.EQ.11) NC=3
  121.  152          CALL LIRMOT(MOFOR4,3,IMLU,0)
  122.               IF (IMLU.EQ.0) GOTO 999
  123.               CALL LIRREE(VAL,1,IRETOU)
  124.               IF (IERR.NE.0) RETURN
  125.               MOTFOR(**)=MOFOR4(IMLU)
  126.               VALFOR(**)=VAL
  127.               GOTO 152
  128.             ENDIF
  129.           ELSE IF (IFOMOD.EQ.4) THEN
  130.             NC=1
  131.             IF (IFOUR.EQ.14) NC=2
  132.  16         CALL LIRMOT(MOFOR2,2,IMLU,0)
  133.             IF (IMLU.EQ.0) GOTO 999
  134.             CALL LIRREE(VAL,1,IRETOU)
  135.             IF (IERR.NE.0) RETURN
  136.             MOTFOR(**)=MOFOR2(IMLU)
  137.             VALFOR(**)=VAL
  138.             GOTO 16
  139.           ELSE IF (IFOMOD.EQ.5) THEN
  140.  17         CALL LIRMOT(MOFOR2,1,IMLU,0)
  141.             IF (IMLU.EQ.0) GOTO 999
  142.             CALL LIRREE(VAL,1,IRETOU)
  143.             IF (IERR.NE.0) RETURN
  144.             MOTFOR(**)=MOFOR2(IMLU)
  145.             VALFOR(**)=VAL
  146.             GOTO 17
  147.           ENDIF
  148.         ELSE IF (LTYP.EQ.2) THEN
  149.           IF (IFOMOD.EQ.-1) THEN
  150. C    ON INTRODUIT LES MOMENTS EN DEFO PLANE GENE (MX,MY,MZ)
  151.  21         IF (IFOUR.EQ.-3) THEN
  152.               CALL LIRMOT(MOMOM4,3,IMLU,0)
  153.               IF (IMLU.EQ.0) GOTO 999
  154.               CALL LIRREE(VAL,1,IRETOU)
  155.               IF (IERR.NE.0) RETURN
  156.               MOTFOR(**)=MOMOM4(IMLU)
  157.               VALFOR(**)=VAL
  158.             ELSE
  159.               CALL LIRMOT(MOMOM1,1,IMLU,0)
  160.               IF (IMLU.EQ.0) GOTO 999
  161.               CALL LIRREE(VAL,1,IRETOU)
  162.               IF (IERR.NE.0) RETURN
  163.               MOTFOR(**)=MOMOM1(IMLU)
  164.               VALFOR(**)=VAL
  165.             ENDIF
  166.             GOTO 21
  167.           ELSE IF (IFOMOD.EQ.0) THEN
  168.  22         CALL LIRMOT(MOMOM2,1,IMLU,0)
  169.             IF (IMLU.EQ.0) GOTO 999
  170.             CALL LIRREE(VAL,1,IRETOU)
  171.             IF (IERR.NE.0) RETURN
  172.             MOTFOR(**)=MOMOM2(IMLU)
  173.             VALFOR(**)=VAL
  174.             GOTO 22
  175.           ELSE IF (IFOMOD.EQ.1) THEN
  176.  23         CALL LIRMOT(MOMOM3,2,IMLU,0)
  177.             IF (IMLU.EQ.0) GOTO 999
  178.             CALL LIRREE(VAL,1,IRETOU)
  179.             IF (IERR.NE.0) RETURN
  180.             MOTFOR(**)=MOMOM3(IMLU)
  181.             VALFOR(**)=VAL
  182.             GOTO 23
  183.           ELSE IF (IFOMOD.EQ.2) THEN
  184.  24         CALL LIRMOT(MOMOM4,3,IMLU,0)
  185.             IF (IMLU.EQ.0) GOTO 999
  186.             CALL LIRREE(VAL,1,IRETOU)
  187.             IF (IERR.NE.0) RETURN
  188.             MOTFOR(**)=MOMOM4(IMLU)
  189.             VALFOR(**)=VAL
  190.             GOTO 24
  191. C*OF Pas de MOMENT en 1D (IFOMOD=3,4,5)
  192.           ENDIF
  193.         ENDIF
  194.  999    IF (MOTFOR(/2).EQ.0) THEN
  195.           CALL ERREUR(533)
  196.           RETURN
  197.         ENDIF
  198.       ENDIF
  199.  
  200.       CALL LIROBJ('POINT   ',IPT1,0,IRETOU)
  201. C  ON A BIEN LU UN POINT (application du chargement)
  202.       IF (IRETOU.NE.0) THEN
  203.         CALL CRELEM(IPT1)
  204. C  A T ON UN OBJET DE TYPE ELEMENT SI OUI ON LE TRAN EN POINT
  205.       ELSE
  206.         CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  207.         IF (IERR.NE.0) RETURN
  208.         CALL CHANGE(IPT1,1)
  209.       ENDIF
  210.  
  211. CCCCCCCCCCCCC ON N A PAS D ERREUR ON RECUPERE LES COORDONNEES DU
  212. C             VECTEUR ET LE NUMERO DU POINT
  213.       IF (IRET1.EQ.1) THEN
  214.         SEGACT,MCOORD
  215.         iNoe=(NOEUD-1)*(IDIM+1)
  216.         DO i=1,IDIM
  217.           VEC(i)=XCOOR(iNoe+i)
  218.         ENDDO
  219. CCCCCCCCCCCCCC ON RECUPERE LE NUMERO DU POINT
  220. CCCCCCCCCCCCCC ON COMPTE LE NOMBRE DE COMPOSANTE ET L ADRESSE
  221. CCCCCCCCCCCCCC DANS LE TABLEAU DU TYPE DES DDL SUIVANT L OPTION
  222.         JDIM=IDIM
  223.         IF (LTYP.EQ.2) THEN
  224.           IF (IFOMOD.LE.1) THEN
  225.             JDEC=9
  226.             JDIM=1
  227.           ELSE IF (IFOMOD.EQ.2) THEN
  228.             JDEC=6
  229.           ELSE
  230.             CALL ERREUR(533)
  231.             RETURN
  232.           ENDIF
  233.         ELSE IF (LTYP.EQ.1) THEN
  234.           JDEC=0
  235.           IF (IFOMOD.EQ.1) THEN
  236.             JDEC=3
  237.             JDIM=3
  238.           ELSE IF (IFOMOD.EQ.0) THEN
  239.             JDEC=3
  240.           ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  241.             JDEC=3
  242.           ENDIF
  243.         ELSE
  244.           MOTERR(1:4)=LOCERR
  245.           CALL ERREUR(5)
  246.           RETURN
  247.         ENDIF
  248.         NC=JDIM
  249.       ELSE
  250.         NC=MOTFOR(/2)
  251.       ENDIF
  252.  
  253. CCCCCCCCCCC CREATION DU SEGMENT GEOMETRIE
  254.       NSOUPO=1
  255.       NAT=1
  256.       SEGINI,MCHPOI
  257.       MTYPOI='FORCES'
  258.       MOCHDE='                CHPOINT CREE PAR FORCE '
  259.       IFOPOI=IFOUR
  260.       JATTRI(1)=2
  261.       SEGINI,MSOUPO
  262.       IPCHP(1)=MSOUPO
  263.       IGEOC=IPT1
  264.       IF (IRET1.EQ.1) THEN
  265.         DO i=1,NC
  266.           NOHARM(i)=NIFOUR
  267.           NOCOMP(i)=MOTYPO(JDEC+i)
  268.         ENDDO
  269.       ELSE
  270.         DO i=1,NC
  271.           NOHARM(i)=NIFOUR
  272.           NOCOMP(i)=MOTFOR(i)
  273.         ENDDO
  274.       ENDIF
  275.       MELEME=IPT1
  276.       SEGACT,MELEME
  277.       N=NUM(/2)
  278.       SEGINI,MPOVAL
  279.       IPOVAL=MPOVAL
  280.       IF (IRET1.EQ.1) THEN
  281.         DO i=1,NC
  282.           zz=VEC(i)/N
  283.           DO j=1,N
  284.             VPOCHA(j,i)=zz
  285.           ENDDO
  286.         ENDDO
  287.       ELSE
  288.         DO i=1,NC
  289.           zz=VALFOR(i)/N
  290.           DO j=1,N
  291.             VPOCHA(j,i)=zz
  292.           ENDDO
  293.         ENDDO
  294.       ENDIF
  295.  
  296.       IP2=MCHPOI
  297.       CALL ACTOBJ('CHPOINT ',IP2,1)
  298.       CALL ECROBJ('CHPOINT ',IP2)
  299.       IF (IRET1.EQ.0) SEGSUP,MSWMOT,MSWVAL
  300.  
  301.       RETURN
  302.  
  303.  200  continue
  304.       call force2(ipt)
  305.       END
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  

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