1 : C FPCOQ4 SOURCE FANDEUR 10/08/31 21:17:02 6734 2 : SUBROUTINE FPCOQ4(IPTVPR,IPMAIL,IPTINT,IVAFOR) 3 : *____________________________________________________________________ 4 : * 5 : * CALCULE LES FORCES DE PRESSIONS SUR LES COQUES COQ4 3D 6 : * 7 : * ENTREES : 8 : * --------- 9 : * 10 : * IPTVPR MELVAL CONTENANT LES PRESSIONS APPLIQUEES 11 : * IPMAIL OBJET GEOMETRIQUE 12 : * IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 13 : * (SEGMENT ACTIF EN ENTREE ET EN SORTIE) 14 : * IVAFOR POINTEUR SUR UN MPTVAL ET DES MELVALS DEVANT CONTENIR 15 : * LES FORCES NODALES RESULTANTES 16 : * 17 : * G. M. GIANNUZZI SETT 86 18 : * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12 09 90 19 : * 20 : *____________________________________________________________________ 21 : * 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : * 25 : -INC SMCHAML 26 : -INC SMELEME 27 : -INC SMINTE 28 : -INC SMCOORD 29 : -INC CCOPTIO 30 : * 31 : SEGMENT MPTVAL 32 : INTEGER IPOS(NS) ,NSOF(NS) 33 : INTEGER IVAL(NCOSOU) 34 : CHARACTER*16 TYVAL(NCOSOU) 35 : ENDSEGMENT 36 : * 37 : DIMENSION XE(3,4),XEL(3,4),BPSS(3,3) 38 : DIMENSION SHP(6,4),FTLOC(24),FTGLO(24) 39 : * 40 : * On passe le MELVAL aux points de gauss pour la rigidite 41 : * 41 : CALL VALMEL(IPTVPR,IPTINT,IPRES) 42 : MELVA1=IPRES 43 : * 44 : MINTE=IPTINT 45 : C* SEGACT MINTE <- ACTIF EN E/S 46 : NBPGAU=POIGAU(/1) 47 : NBGM1 =NBPGAU-1 48 : * 49 : MELEME=IPMAIL 50 : * 51 : NBPTEL=NUM(/1) 52 : NBELEM=NUM(/2) 53 : * 54 : SEGACT MCOORD 55 : * 56 : * BOUCLE SUR LES ELEMENTS 57 : * 58 : DO 1000 IB=1,NBELEM 58 : CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE) 59 : * 60 : * MATRICE DE PASSAGE ET COORDONNEES LOCALES 61 : * 61 : CALL CQ4LOC(XE,XEL,BPSS,IERR,0) 61 : CALL TRPOSE(BPSS) 62 : * 63 : * MISE A 0 DU VECTEUR FORCE 64 : * 65 : DO 100 I=1,24 66 : 100 FTLOC(I)=0.D0 67 : * 68 : * INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS 69 : * IA NUMERO D UN NOEUD 70 : * 71 : IBMN=MIN(IB,MELVA1.VELCHE(/2)) 72 : DO 200 IGAU=1,NBGM1 73 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) 74 : PRE=MELVA1.VELCHE(IGMN,IBMN) 75 : DO 500 IA =1,NBPTEL 76 : SHP(1,IA)=SHPTOT(1,IA,IGAU) 77 : SHP(2,IA)=SHPTOT(2,IA,IGAU) 78 : SHP(3,IA)=SHPTOT(3,IA,IGAU) 79 : 500 CONTINUE 79 : CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC) 80 : * 81 : DJAC=DJAC*POIGAU(IGAU)*PRE 82 : DO 550 NP=1,NBPTEL 83 : IC =(NP-1)*6+3 84 : FTLOC(IC)=FTLOC(IC)+SHP(1,NP)*DJAC 85 : 550 CONTINUE 86 : 200 CONTINUE 87 : * 88 : * CHANGEMENT DE REPERE 89 : * 89 : CALL MATVEC(FTLOC,FTGLO,BPSS,8) 90 : IE=0 91 : MPTVAL=IVAFOR 92 : DO 560 IC=1,4 93 : DO 560 ID=1,6 94 : IE=IE+1 95 : MELVAL=IVAL(ID) 96 : VELCHE(IC,IB)=FTGLO(IE) 97 : 560 CONTINUE 98 : 1000 CONTINUE 99 : * 100 : SEGSUP MELVA1 101 : C* SEGDES MINTE <- ACTIF EN E/S 102 : * 103 : RETURN 104 : END 105 : 106 :
© Cast3M 2003 - All rights reserved.
Disclaimer