1 : C KREM3G SOURCE CHAT 05/01/13 01:06:19 5004 2 : SUBROUTINE KREM3G(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3 3 : * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C---------------------------------------------------------------------- 7 : C Calcul des facteurs de forme en 3D 8 : C Sp appele par KPROJG 9 : C 10 : C CAS DE 3 FACES DIFFERENTES NON PARALLELES 11 : C ----------------------------------------- 12 : C 13 : C---------------------------------------------------------------------- 14 : C 15 : DIMENSION U2(4),KC1(2),KG(2),KH(2) 16 : -INC TFFOR3D 17 : C 18 : SEGMENT SPROJP 19 : INTEGER KF(NPT),ICOO(2,NPT) 20 : REAL*8 XR(3,NPT) 21 : ENDSEGMENT 22 : C 23 : SEGMENT SKSEGM 24 : INTEGER KKSEGM(2,NSEGM) 25 : ENDSEGMENT 26 : C 27 : C DESCRIPTION DES ARETES 28 : C 29 : SEGMENT SKCEL 30 : INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC) 31 : REAL*8 RMAX 32 : ENDSEGMENT 33 : C 34 : C-------------------------------------------------------------------- 35 : NR = IR(/1) 36 : C 37 : C WRITE(6,*) ' KREM3G K2 ',K2 38 : C WRITE(6,*) ' NF ',NF1,NF2,NF3 39 : C WRITE(6,*) ' NFA ',NFA(NA1),NFA(NA2),NFA(NA3) 40 : C 41 : C 42 : C 43 : IF (NFA(NA1).NE.3.AND.NFA(NA2).NE.3.AND.NFA(NA3).NE.3) THEN 44 : C 45 : C PAS DE FACE GENEREE 46 : C ------------------- 47 : C 47 : CALL KINITB(KBCEL,NR,NR,KG,NG) 47 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 47 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 47 : CALL KFINSO(NF2,NF3,KA,IM,KH) 48 : KG(1) = ( KG(1)/2 + KH(1) )/2 49 : KG(2) = ( KG(2)/2 + KH(2) )/2 49 : CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 50 : 50 : CALL KINITB(KBCEL,NR,NR,KG,NG) 50 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 50 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 50 : CALL KFINSO(NF1,NF3,KA,IM,KH) 51 : KG(1) = ( KG(1)/2 + KH(1) )/2 52 : KG(2) = ( KG(2)/2 + KH(2) )/2 52 : CALL KREMPI(NIN,K2,KG,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 53 : 53 : CALL KINITB(KBCEL,NR,NR,KG,NG) 53 : CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 53 : CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 53 : CALL KFINSO(NF1,NF2,KA,IM,KH) 54 : KG(1) = ( KG(1)/2 + KH(1) )/2 55 : KG(2) = ( KG(2)/2 + KH(2) )/2 55 : CALL KREMPI(NIN,K2,KG,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF) 56 : 57 : ELSE 58 : C 59 : C IL EXISTE UNE FACE GENEREE 60 : C --------------------------- 61 : C 62 : IF (NFA(NA2).EQ.3) THEN 63 : KC1(1) = ICOO(1,NS1) 64 : KC1(2) = ICOO(2,NS1) 64 : CALL KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1 65 : - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 66 : ENDIF 67 : C 68 : IF (NFA(NA3).EQ.3) THEN 69 : KC1(1) = ICOO(1,NS2) 70 : KC1(2) = ICOO(2,NS2) 70 : CALL KREM3F(K2,KG,NG,KC1,NA3,NF3,NF1,NF2,NA1,NA2 71 : - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 72 : ENDIF 73 : 74 : IF (NFA(NA1).EQ.3) THEN 75 : KC1(1) = ICOO(1,NS3) 76 : KC1(2) = ICOO(2,NS3) 76 : CALL KREM3F(K2,KG,NG,KC1,NA1,NF1,NF2,NF3,NA2,NA3 77 : - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 78 : ENDIF 79 : 80 : ENDIF 81 : C 82 : RETURN 83 : END 84 : 85 :
© Cast3M 2003 - All rights reserved.
Disclaimer