C FORCE SOURCE FANDEUR 22/01/03 21:15:17 11136 C======================================================================= C= OPERATEUR FORCE OU MOMENT C C= SYNTAXE CHP1=FORCE I VECTEUR I OBJET ; C= I NOMFORC VAL ... I C C= CHP2=MOMEN I VECTEUR I OBJET ; C= I NOMMOME VAL ... I C C= VECTEUR EST LE VECTEUR FORCE TOTAL APPLIQUE C= A L OBJET QUI PEUT ETRE UNE LISTE C= DE POINTS OU D ELEMENTS C======================================================================= SUBROUTINE FORCE(LTYP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMCHPOI -INC SMCOORD SEGMENT MSWMOT CHARACTER*(LOCOMP) MOTFOR(0) ENDSEGMENT SEGMENT MSWVAL REAL*8 VALFOR(0) ENDSEGMENT DIMENSION VEC(3) CHARACTER*4 MOFOR1(2),MOFOR2(2),MOFOR3(3),MOFOR4(3),MOFOR5(2) CHARACTER*4 MOTYPO(10) 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 DE C 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) THEN C 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) THEN C 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 24 C*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 DU C 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) ENDDO CCCCCCCCCCCCCC ON RECUPERE LE NUMERO DU POINT CCCCCCCCCCCCCC ON COMPTE LE NOMBRE DE COMPOSANTE ET L ADRESSE CCCCCCCCCCCCCC 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 ' 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 IP2=MCHPOI CALL ACTOBJ('CHPOINT ',IP2,1) CALL ECROBJ('CHPOINT ',IP2) IF (IRET1.EQ.0) SEGSUP,MSWMOT,MSWVAL RETURN 200 continue call force2(ipt) END