Numérotation des lignes :

C FORCE     SOURCE    KICH      08/07/30    21:15:11     6140 C=======================================================================C=          OPERATEUR FORCE OU MOMENTCC=             SYNTAXE CHP1=FORCE  I    VECTEUR          I  OBJET ;C=                                 I  NOMFORC  VAL  ...  ICC=                     CHP2=MOMEN  I    VECTEUR          I  OBJET ;C=                                 I  NOMMOME  VAL  ...  ICC=                           VECTEUR EST LE VECTEUR FORCE TOTAL APPLIQUEC=                                    A L OBJET QUI PEUT ETRE UNE LISTEC=                                    DE POINTS OU D ELEMENTSC=======================================================================       SUBROUTINE FORCE(LTYP)       IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO-INC SMELEME-INC SMCHPOI-INC SMCOORD       SEGMENT MSWMOT        CHARACTER*4 MOTFOR(0)      ENDSEGMENT      SEGMENT MSWVAL        REAL*8 VALFOR(0)      ENDSEGMENT       DIMENSION VEC(3)      CHARACTER*4 MOTYPO(10),charm,charre,typret      CHARACTER*4 MOFOR1(2),MOFOR2(2),MOFOR3(3),MOFOR4(3),MOFOR5(2)      CHARACTER*4 MOMOM1(1),MOMOM2(1),MOMOM3(2),MOMOM4(3)      REAL*8 XXA,vval,X0,X1        DATA MOTYPO / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ',     .              'MX  ','MY  ','MZ  ','MT  ' /      DATA MOFOR1 / 'FX  ','FY  ' /      DATA MOFOR2 / 'FR  ','FZ  ' /      DATA MOFOR3 / 'FR  ','FZ  ','FT  ' /      DATA MOFOR4 / 'FX  ','FY  ','FZ  ' /      DATA MOFOR5 / 'FX  ','FZ  ' /      DATA MOMOM1 / 'MZ  ' /      DATA MOMOM2 / 'MT  ' /      DATA MOMOM3 / 'MT  ','MZ  ' /      DATA MOMOM4 / 'MX  ','MY  ','MZ  ' /        call lirtab('LIAISONS_STATIQUES',ipt,0,iret1)      if (iret1.ne.0) goto 200 CCCCCCCCCC ON LIT SOIT UN VECTEUR , SOIT UN OU PLUSIEURS NOMS DEC    COMPOSANTES ACCOMPAGNES D'UN FLOTTANT       CALL LIROBJ('POINT   ',NOEUD,0,IRET1)      IF (IRET1.EQ.0) THEN        SEGINI,MSWMOT,MSWVAL        IF (LTYP.EQ.1) THEN          IF (IFOMOD.EQ.-1) THENC  ON INTRODUIT LES FORCES EN DEFO PLANE GENE (FX,FY,FZ) 11         IF (IFOUR.EQ.-3) THEN              CALL LIRMOT(MOFOR4,3,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOFOR4(IMLU)              VALFOR(**)=VAL            ELSE              CALL LIRMOT(MOFOR1,2,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOFOR1(IMLU)              VALFOR(**)=VAL            ENDIF            GOTO 11          ELSE IF(IFOMOD.EQ.0) THEN 12         CALL LIRMOT(MOFOR2,2,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOFOR2(IMLU)            VALFOR(**)=VAL            GOTO 12          ELSE IF (IFOMOD.EQ.1) THEN 13         CALL LIRMOT(MOFOR3,3,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOFOR3(IMLU)            VALFOR(**)=VAL            GOTO 13          ELSE IF (IFOMOD.EQ.2) THEN 14         CALL LIRMOT(MOFOR4,3,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOFOR4(IMLU)            VALFOR(**)=VAL            GOTO 14          ELSE IF (IFOMOD.EQ.3) THEN            IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) THEN 151          CALL LIRMOT(MOFOR5,2,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOFOR5(IMLU)              VALFOR(**)=VAL              GOTO 151            ELSE              NC=1              IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) NC=2              IF (IFOUR.EQ.11) NC=3 152          CALL LIRMOT(MOFOR4,3,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOFOR4(IMLU)              VALFOR(**)=VAL              GOTO 152            ENDIF          ELSE IF (IFOMOD.EQ.4) THEN            NC=1            IF (IFOUR.EQ.14) NC=2 16         CALL LIRMOT(MOFOR2,2,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOFOR2(IMLU)            VALFOR(**)=VAL            GOTO 16          ELSE IF (IFOMOD.EQ.5) THEN 17         CALL LIRMOT(MOFOR2,1,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOFOR2(IMLU)            VALFOR(**)=VAL            GOTO 17          ENDIF        ELSE IF (LTYP.EQ.2) THEN          IF (IFOMOD.EQ.-1) THENC    ON INTRODUIT LES MOMENTS EN DEFO PLANE GENE (MX,MY,MZ) 21         IF (IFOUR.EQ.-3) THEN              CALL LIRMOT(MOMOM4,3,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOMOM4(IMLU)              VALFOR(**)=VAL            ELSE              CALL LIRMOT(MOMOM1,1,IMLU,0)              IF (IMLU.EQ.0) GOTO 999              CALL LIRREE(VAL,1,IRETOU)              IF (IERR.NE.0) RETURN              MOTFOR(**)=MOMOM1(IMLU)              VALFOR(**)=VAL            ENDIF            GOTO 21          ELSE IF (IFOMOD.EQ.0) THEN 22         CALL LIRMOT(MOMOM2,1,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOMOM2(IMLU)            VALFOR(**)=VAL            GOTO 22          ELSE IF (IFOMOD.EQ.1) THEN 23         CALL LIRMOT(MOMOM3,2,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOMOM3(IMLU)            VALFOR(**)=VAL            GOTO 23          ELSE IF (IFOMOD.EQ.2) THEN 24         CALL LIRMOT(MOMOM4,3,IMLU,0)            IF (IMLU.EQ.0) GOTO 999            CALL LIRREE(VAL,1,IRETOU)            IF (IERR.NE.0) RETURN            MOTFOR(**)=MOMOM4(IMLU)            VALFOR(**)=VAL            GOTO 24C*OF Pas de MOMENT en 1D (IFOMOD=3,4,5)          ENDIF        ENDIF 999    IF (MOTFOR(/2).EQ.0) THEN          CALL ERREUR(533)          RETURN        ENDIF      ENDIF       CALL LIROBJ('POINT   ',IPT1,0,IRETOU)C  ON A BIEN LU UN POINT (application du chargement)      IF (IRETOU.NE.0) THEN        CALL CRELEM(IPT1)C  A T ON UN OBJET DE TYPE ELEMENT SI OUI ON LE TRAN EN POINT      ELSE        CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)        IF (IERR.NE.0) RETURN        CALL CHANGE(IPT1,1)      ENDIF CCCCCCCCCCCCC ON N A PAS D ERREUR ON RECUPERE LES COORDONNEES DUC             VECTEUR ET LE NUMERO DU POINT      IF (IRET1.EQ.1) THEN        SEGACT,MCOORD        iNoe=(NOEUD-1)*(IDIM+1)        DO i=1,IDIM          VEC(i)=XCOOR(iNoe+i)        ENDDOCCCCCCCCCCCCCC ON RECUPERE LE NUMERO DU POINTCCCCCCCCCCCCCC ON COMPTE LE NOMBRE DE COMPOSANTE ET L ADRESSECCCCCCCCCCCCCC DANS LE TABLEAU DU TYPE DES DDL SUIVANT L OPTION        JDIM=IDIM        IF (LTYP.EQ.2) THEN          IF (IFOMOD.LE.1) THEN            JDEC=9            JDIM=1          ELSE IF (IFOMOD.EQ.2) THEN            JDEC=6          ELSE            CALL ERREUR(533)            RETURN          ENDIF        ELSE IF (LTYP.EQ.1) THEN          JDEC=0          IF (IFOMOD.EQ.1) THEN            JDEC=3            JDIM=3          ELSE IF (IFOMOD.EQ.0) THEN            JDEC=3          ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN            JDEC=3          ENDIF        ELSE          MOTERR(1:4)=LOCERR          CALL ERREUR(5)          RETURN        ENDIF        NC=JDIM      ELSE        NC=MOTFOR(/2)      ENDIF CCCCCCCCCCC CREATION DU SEGMENT GEOMETRIE      NSOUPO=1      NAT=1      SEGINI,MCHPOI      MTYPOI='FORCES'      MOCHDE='                CHPOINT CREE PAR FORCE 'C*    IFOPOI=IFOMOD      IFOPOI=IFOUR      JATTRI(1)=2      SEGINI,MSOUPO      IPCHP(1)=MSOUPO      IGEOC=IPT1      IF (IRET1.EQ.1) THEN        DO i=1,NC          NOHARM(i)=NIFOUR          NOCOMP(i)=MOTYPO(JDEC+i)        ENDDO      ELSE        DO i=1,NC          NOHARM(i)=NIFOUR          NOCOMP(i)=MOTFOR(i)        ENDDO      ENDIF      MELEME=IPT1      SEGACT,MELEME      N=NUM(/2)      SEGINI,MPOVAL      IPOVAL=MPOVAL      IF (IRET1.EQ.1) THEN        DO i=1,NC          zz=VEC(i)/N          DO j=1,N            VPOCHA(j,i)=zz          ENDDO        ENDDO      ELSE        DO i=1,NC          zz=VALFOR(i)/N          DO j=1,N            VPOCHA(j,i)=zz          ENDDO        ENDDO      ENDIF      SEGDES,MELEME,MPOVAL,MSOUPO,MCHPOI       IP2=MCHPOI      CALL ECROBJ('CHPOINT',IP2)      IF (IRET1.EQ.0) SEGSUP,MSWMOT,MSWVAL       RETURN  200  continue      call force2(ipt)      END

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