1 : C FPCO3D SOURCE PV 09/03/12 21:23:03 6325 2 : SUBROUTINE FPCO3D(IPTVPR,IPMAIL,IVAFOR) 3 : C____________________________________________________________________ 4 : C 5 : C CALCULE LES FORCES DE PRESSIONS SUR LES COQUES 3D 6 : C 7 : C 8 : C ENTREES : 9 : C --------- 10 : C 11 : C IPTVPR MELVAL CONTENANT LES PRESSIONS APPLIQUEES (ACTIF) 12 : C IPMAIL OBJET GEOMETRIQUE (ACTIF) 13 : C IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES 14 : C NODALE RESULTANTES 15 : C 16 : C JACQUELINE BROCHARD AVRIL 85 17 : C PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 21 09 90 18 : C 19 : C____________________________________________________________________ 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : C 24 : -INC SMCHAML 25 : -INC SMELEME 26 : -INC SMCOORD 27 : -INC CCOPTIO 28 : C 29 : SEGMENT MPTVAL 30 : INTEGER IPOS(NS) ,NSOF(NS) 31 : INTEGER IVAL(NCOSOU) 32 : CHARACTER*16 TYVAL(NCOSOU) 33 : ENDSEGMENT 34 : C 35 : DIMENSION XE(3,3),XEL(3,3),BPSS(3,3),BB(9),FT(18),F(6) 36 : DIMENSION XX(3),YY(3) 37 : C 38 : DATA XX/0.5D0,0.5D0,0.0D0/ 39 : DATA YY/0.0D0,0.5D0,0.5D0/ 40 : DATA UNTIER/.33333333333333333D0/ 41 : C 42 : MELVA1=IPTVPR 43 : IGMN=MIN(3,MELVA1.VELCHE(/1)) 44 : C 45 : MELEME=IPMAIL 46 : NBELEM=NUM(/2) 47 : C 48 : C BOUCLE SUR LES ELEMENTS 49 : C 50 : DO 1000 IB=1,NBELEM 51 : IBMN=MIN(IB,MELVA1.VELCHE(/2)) 52 : IF (IGMN.EQ.1) THEN 53 : * 54 : * Champ constant 55 : * 56 : P=MELVA1.VELCHE(1,IBMN) 57 : ELSE 58 : * 59 : * P moyen sur l'element 60 : * 61 : P=0.D0 62 : DO 11 IGAU=1,3 63 : P=MELVA1.VELCHE(IGAU,IBMN)+P 64 : 11 CONTINUE 65 : P=P/3 66 : ENDIF 66 : CALL DOXE(XCOOR,IDIM,3,NUM,IB,XE) 67 : C 68 : C MATRICE DE PASSAGE 69 : C 69 : CALL VPAST(XE,BPSS) 70 : C 71 : C COORDONNEES LOCALES 72 : C 72 : CALL VCORLC(XE,XEL,BPSS) 73 : C 74 : C MISE A 0 DU VECTEUR FORCE 75 : C 76 : DO 100 I=1,18 77 : 100 FT(I)=0.D0 78 : X21=XEL(1,2)-XEL(1,1) 79 : Y31=XEL(2,3)-XEL(2,1) 80 : SURF=X21*Y31*.5D0 81 : C 82 : C INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS 83 : C IA NUMERO D UN NOEUD 84 : C 85 : DO 200 IGAU=1,3 85 : CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB) 86 : DO 210 IA=1,3 87 : IP=(IA-1)*6+2 88 : IK=(IA-1)*3 89 : DO 220 ID=1,3 90 : FT(IP+ID)=FT(IP+ID)+UNTIER*BB(IK+ID) 91 : 220 CONTINUE 92 : 210 CONTINUE 93 : 200 CONTINUE 94 : C 95 : C MULTIPLICATION PAR P*SURF 96 : C 97 : DO 300 I=1,18 98 : FT(I)=FT(I)*SURF*P 99 : 300 CONTINUE 100 : C 101 : C CHANGEMENT DE REPERE 102 : C 103 : DO 400 I=1,3 104 : KP=6*(I-1) 105 : MP=KP+3 106 : DO 401 II=1,6 107 : 401 F(II)=0.D0 108 : DO 402 J=1,3 109 : LP=J 110 : NP=LP+3 111 : DO 403 JP=1,3 112 : F(LP)=F(LP)+BPSS(JP,J)*FT(JP+KP) 113 : F(NP)=F(NP)+BPSS(JP,J)*FT(JP+MP) 114 : 403 CONTINUE 115 : 402 CONTINUE 116 : MPTVAL=IVAFOR 117 : DO 410 K=1,6 118 : MELVAL=IVAL(K) 119 : VELCHE(I,IB)=F(K) 120 : 410 CONTINUE 121 : 400 CONTINUE 122 : 1000 CONTINUE 123 : RETURN 124 : END 125 : 126 : 127 : 128 :
© Cast3M 2003 - All rights reserved.
Disclaimer