Numérotation des lignes :

C KREM2G    SOURCE    CHAT      05/01/13    01:06:13     5004      SUBROUTINE KREM2G(K2,NF1,NF2,NA1,NA2,NA3,C,U2,SHC3D,SKCEL     -                  ,SPROJA,SKBUFF)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C----------------------------------------------------------------------C Calcul des facteurs de forme en 3DC Sp appele par kprojgCC     CAS DE 2 FACES DIFFERENTES NF1 ET NF2 NON PARALLELESC     ____________________________________________________CC     CAS 1 DE KEMP2FCCC     NF3 = NF1 ( ARETE NA3)C----------------------------------------------------------------------      DIMENSION U2(1),KG(2),KH(2) -INC TFFOR3D      SEGMENT SKCEL      INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)      REAL*8   RMAX      ENDSEGMENTCC      CAS NON PARALLELEC      -----------------C       IF (NFA(NA1).EQ.3)  THEN        NF = IFA(3,NA1)        IF (NFA(NA2).EQ.3) THEN          IF (IFA(3,NA2).EQ.NF) THENC     WRITE(6,*) ' KREMP2F CAS 1 NF ',NFCC   FACE 1 ARETES 1 2 3C      CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)          ELSE            WRITE(6,*) ' ERREUR KREM2G ',NF,IFA(3,NA2)          ENDIF        ELSEC     WRITE(6,*) ' KREMP2F CAS 2 NF ',NF CC   FACE 1 ARETES 1 2 3C      CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF2,NF,KA,IM,KH)      KG(1) = ( KG(1)/3 + KH(1) )/2      KG(2) = ( KG(2)/3 + KH(2) )/2      CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF,NF1,KA,IM,KH)      KH(1) = ( KG(1)/2 + KH(1) )/2      KH(2) = ( KG(2)/2 + KH(2) )/2      CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF1,NF2,KA,IM,KG)      CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)        ENDIF      ELSE        IF (NFA(NA2).EQ.3) THEN        NF = IFA(3,NA2)C     WRITE(6,*) ' KREMP2F CAS 3 NF ',NFCC   FACE 1 ARETES 1 2 3C      CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF2,NF,KA,IM,KH)      KG(1) = ( KG(1)/3 + KH(1) )/2      KG(2) = ( KG(2)/3 + KH(2) )/2      CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF,NF1,KA,IM,KH)      KH(1) = ( KG(1)/2 + KH(1) )/2      KH(2) = ( KG(2)/2 + KH(2) )/2      CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KFINSO(NF1,NF2,KA,IM,KG)      CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)         ELSECC   FACE 1 ARETES 1 2 3C      CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)CC   FACE 2 ARETES 1 2C       CALL KINITB(KBCEL,NRES,NRES,KG,NG)      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)      CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)C        ENDIF      ENDIF       RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales