1 : C KREM3F SOURCE CHAT 05/01/13 01:06:16 5004 2 : SUBROUTINE KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1 3 : - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 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 krem3g 9 : C 3 FACES DIFFERENTES NON PARALLELES 10 : C ---------------------------------- 11 : C 12 : C IL EXISTE UNE FACE GENEREE PAR L'ARETE NA2 13 : C ------------------------------------------- 14 : C 15 : C---------------------------------------------------------------------- 16 : DIMENSION KG(2),KH(2),KC1(2) 17 : -INC TFFOR3D 18 : 19 : SEGMENT SKCEL 20 : INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC) 21 : REAL*8 RMAX 22 : ENDSEGMENT 23 : IF (IFA(3,NA2).EQ.NF1) THEN 24 : 24 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 24 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 24 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 24 : CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 25 : 25 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 25 : CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 25 : CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 25 : CALL KREMPI(NIN,K2,KG,NG,NF3,C,U2,SHC3D,SKCEL,SKBUFF) 26 : 26 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 26 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 26 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 27 : KH(1) = (KG(1)/2 + KC1(1))/2 28 : KH(2) = (KG(2)/2 + KC1(2))/2 29 : NG = 0 30 : KG(1) = 0 31 : KG(2) = 0 31 : CALL KREMPA(K2,KG,NG,NFN,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 32 : KH(1) = (KG(1) + KH(1))/2 33 : KH(2) = (KG(2) + KH(2))/2 33 : CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 34 : 35 : ELSE 36 : NFF = IFA(3,NA2) 37 : 38 : C WRITE(6,*) ' KREMPY NFF ',NFF 38 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 38 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 38 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 38 : CALL KFINSO(NF1,NF3,KA,IM,KH) 38 : CALL KFINSO(NFF,NF3,KA,IM,KG) 39 : KH(1) = (KG(1) + KH(1))/2 40 : KH(2) = (KG(2) + KH(2))/2 40 : CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 41 : 41 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 41 : CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 41 : CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 41 : CALL KFINSO(NF1,NF2,KA,IM,KH) 41 : CALL KFINSO(NFF,NF2,KA,IM,KG) 42 : KH(1) = (KG(1) + KH(1))/2 43 : KH(2) = (KG(2) + KH(2))/2 43 : CALL KREMPI(NIN,K2,KH,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF) 44 : 44 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 44 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 44 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 44 : CALL KFINSO(NF2,NF3,KA,IM,KH) 45 : KH(1) = (KG(1)/2 + KH(1))/2 46 : KH(2) = (KG(2)/2 + KH(2))/2 46 : CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 47 : C 47 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 47 : CALL KREMPA(K2,KG,NG,NFF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 47 : CALL KFINSO(NF2,NF3,KA,IM,KG) 47 : CALL KREMPI(NIN,K2,KG,1,NFF,C,U2,SHC3D,SKCEL,SKBUFF) 48 : ENDIF 49 : 50 : RETURN 51 : END 52 : 53 :
© Cast3M 2003 - All rights reserved.
Disclaimer