1 : C KREM2G SOURCE CHAT 05/01/13 01:06:13 5004 2 : SUBROUTINE KREM2G(K2,NF1,NF2,NA1,NA2,NA3,C,U2,SHC3D,SKCEL 3 : - ,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 kprojg 9 : C 10 : C CAS DE 2 FACES DIFFERENTES NF1 ET NF2 NON PARALLELES 11 : C ____________________________________________________ 12 : C 13 : C CAS 1 DE KEMP2F 14 : C 15 : C 16 : C NF3 = NF1 ( ARETE NA3) 17 : C---------------------------------------------------------------------- 18 : DIMENSION U2(1),KG(2),KH(2) 19 : 20 : -INC TFFOR3D 21 : SEGMENT SKCEL 22 : INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC) 23 : REAL*8 RMAX 24 : ENDSEGMENT 25 : C 26 : C CAS NON PARALLELE 27 : C ----------------- 28 : C 29 : 30 : IF (NFA(NA1).EQ.3) THEN 31 : NF = IFA(3,NA1) 32 : IF (NFA(NA2).EQ.3) THEN 33 : IF (IFA(3,NA2).EQ.NF) THEN 34 : C WRITE(6,*) ' KREMP2F CAS 1 NF ',NF 35 : C 36 : C FACE 1 ARETES 1 2 3 37 : C 37 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 37 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 37 : CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 37 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 37 : CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 38 : 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 KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 39 : 39 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 39 : CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 39 : CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 39 : CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF) 40 : ELSE 41 : WRITE(6,*) ' ERREUR KREM2G ',NF,IFA(3,NA2) 42 : ENDIF 43 : ELSE 44 : C WRITE(6,*) ' KREMP2F CAS 2 NF ',NF 45 : 46 : C 47 : C FACE 1 ARETES 1 2 3 48 : C 48 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 48 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 48 : CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 48 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 48 : CALL KFINSO(NF2,NF,KA,IM,KH) 49 : KG(1) = ( KG(1)/3 + KH(1) )/2 50 : KG(2) = ( KG(2)/3 + KH(2) )/2 50 : CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 51 : 51 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 51 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 51 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 51 : CALL KFINSO(NF,NF1,KA,IM,KH) 52 : KH(1) = ( KG(1)/2 + KH(1) )/2 53 : KH(2) = ( KG(2)/2 + KH(2) )/2 53 : CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 54 : 54 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 54 : CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 54 : CALL KFINSO(NF1,NF2,KA,IM,KG) 54 : CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF) 55 : ENDIF 56 : ELSE 57 : IF (NFA(NA2).EQ.3) THEN 58 : NF = IFA(3,NA2) 59 : C WRITE(6,*) ' KREMP2F CAS 3 NF ',NF 60 : C 61 : C FACE 1 ARETES 1 2 3 62 : C 62 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 62 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 62 : CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 62 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 62 : CALL KFINSO(NF2,NF,KA,IM,KH) 63 : KG(1) = ( KG(1)/3 + KH(1) )/2 64 : KG(2) = ( KG(2)/3 + KH(2) )/2 64 : CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 65 : 65 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 65 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 65 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 65 : CALL KFINSO(NF,NF1,KA,IM,KH) 66 : KH(1) = ( KG(1)/2 + KH(1) )/2 67 : KH(2) = ( KG(2)/2 + KH(2) )/2 67 : CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 68 : 68 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 68 : CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 68 : CALL KFINSO(NF1,NF2,KA,IM,KG) 68 : CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF) 69 : 70 : ELSE 71 : C 72 : C FACE 1 ARETES 1 2 3 73 : C 73 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 73 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 73 : CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 73 : CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 73 : CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 74 : C 75 : C FACE 2 ARETES 1 2 76 : C 77 : 77 : CALL KINITB(KBCEL,NRES,NRES,KG,NG) 77 : CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 77 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 77 : CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF) 78 : C 79 : ENDIF 80 : ENDIF 81 : 82 : RETURN 83 : END 84 : 85 :
© Cast3M 2003 - All rights reserved.
Disclaimer