1 : C FPMA2D SOURCE FANDEUR 10/08/31 21:17:11 6734 2 : SUBROUTINE FPMA2D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IVACAR,XP) 3 : C 4 : C____________________________________________________________________ 5 : C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS 6 : C MASSIFS BIDIMENSIONNELS 7 : C 8 : C ENTREES : 9 : C --------- 10 : C 11 : C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES 12 : C 0 SI ON A DONNE UNE VALEUR CONSTANTE 13 : C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE 14 : C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 15 : C (ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION) 16 : C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES 17 : C NODALE RESULTANTES 18 : C IVACAR POINTEUR SUR UN MELVAL DE CARACTERISTIQUES 19 : C 20 : C JACQUELINE BROCHARD AVRIL 85 21 : C 22 : C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90 23 : C 24 : C____________________________________________________________________ 25 : C 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : C 29 : -INC CCREEL 30 : -INC SMCHAML 31 : -INC SMELEME 32 : -INC SMINTE 33 : -INC SMCOORD 34 : -INC CCOPTIO 35 : C 36 : C= Quelques constantes (2.Pi) 37 : PARAMETER (X2Pi=6.283185307179586476925286766559D0) 38 : 39 : SEGMENT WORK 40 : REAL*8 XE(3,NBNN) 41 : ENDSEGMENT 42 : C 43 : SEGMENT MPTVAL 44 : INTEGER IPOS(NS) ,NSOF(NS) 45 : INTEGER IVAL(NCOSOU) 46 : CHARACTER*16 TYVAL(NCOSOU) 47 : ENDSEGMENT 48 : C 49 : * prob optimiseur il faut initialiser melva1 50 : MELVA1=IVAFOR 51 : IF(IPTVPR.NE.0) THEN 52 : MELVA1=IPTVPR 53 : SEGACT MELVA1 54 : ENDIF 55 : MELVAL=MELVA1 56 : C 57 : MINTE=IPTINT 58 : C* SEGACT MINTE <- ACTIF EN E/S 59 : NBPGAU=POIGAU(/1) 60 : C 61 : MELEME=IPMAIL 62 : SEGACT MELEME 63 : NBNN =NUM(/1) 64 : NBELEM=NUM(/2) 65 : SEGINI WORK 66 : DIM3=1.D0 67 : C 68 : C BOUCLE SUR LES ELEMENTS 69 : C 70 : DO 1 IB=1,NBELEM 70 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 71 : C 72 : C BOUCLE SUR LES POINTS DE GAUSS 73 : C 74 : DO 10 IGAU=1,NBPGAU 75 : C 76 : C RECUPERATION DE L'EPAISSEUR 77 : C 78 : IF (IFOUR.EQ.-2) THEN 79 : MPTVAL=IVACAR 80 : IF (IVACAR.NE.0) THEN 81 : IF(IVAL(1).NE.0) THEN 82 : MELVAL=IVAL(1) 83 : IGMN=MIN(IGAU,VELCHE(/1)) 84 : IBMN=MIN(IB,VELCHE(/2)) 85 : DIM3=VELCHE(IGMN,IBMN) 86 : ELSE 87 : DIM3=1.D0 88 : ENDIF 89 : ENDIF 90 : ENDIF 91 : * 92 : VNQSI1=0.D0 93 : VNQSI2=0.D0 94 : T1=0.D0 95 : T2=0.D0 96 : R=0.D0 97 : C 98 : C BOUCLE SUR LES NOEUDS 99 : C 100 : DO 20 I=1,NBNN 101 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 102 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 103 : R=R+SHPTOT(1,I,IGAU)*XE(1,I) 104 : 20 CONTINUE 105 : IF (IFOUR.LT.0) THEN 106 : R=1.D0 107 : ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1 108 : + .AND.NIFOUR.EQ.0)) THEN 109 : R=X2PI*R 110 : ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN 111 : R=XPI*R 112 : ENDIF 113 : IF (IFOUR.EQ.-2) R=R*DIM3 114 : * 115 : IF(IPTVPR.NE.0) THEN 116 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) 117 : IBMN=MIN(IB ,MELVA1.VELCHE(/2)) 118 : T1=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*(-VNQSI2) 119 : T2=POIGAU(IGAU)*MELVA1.VELCHE(IGMN,IBMN)*R*VNQSI1 120 : ELSE 121 : T1=POIGAU(IGAU)*XP*R*(-VNQSI2) 122 : T2=POIGAU(IGAU)*XP*R*VNQSI1 123 : ENDIF 124 : C 125 : MPTVAL=IVAFOR 126 : DO 30 J=1,NBNN 127 : MELVAL=IVAL(1) 128 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1 129 : MELVAL=IVAL(2) 130 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2 131 : 30 CONTINUE 132 : C 133 : 10 CONTINUE 134 : 1 CONTINUE 135 : SEGSUP WORK 136 : C* SEGDES,MINTE <- ACTIF EN E/S 137 : SEGDES,MELEME 138 : IF(IPTVPR.NE.0) SEGDES MELVA1 139 : RETURN 140 : END 141 : 142 :
© Cast3M 2003 - All rights reserved.
Disclaimer