Télécharger la plaquette Cast3M


fr en

Télécharger krem2g.eso

Retour à la liste

Numérotation des lignes : 

krem2g

  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
  38.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  39.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  40.       CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  41.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  42.       CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  43.  
  44.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  45.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  46.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  47.       CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  48.  
  49.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  50.       CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  51.       CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  52.       CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  53.           ELSE
  54.             WRITE(6,*) ' ERREUR KREM2G ',NF,IFA(3,NA2)
  55.           ENDIF
  56.         ELSE
  57. C     WRITE(6,*) ' KREMP2F CAS 2 NF ',NF
  58.  
  59. C
  60. C   FACE 1 ARETES 1 2 3
  61. C
  62.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  63.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  64.       CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  65.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  66.       CALL KFINSO(NF2,NF,KA,IM,KH)
  67.       KG(1) = ( KG(1)/3 + KH(1) )/2
  68.       KG(2) = ( KG(2)/3 + KH(2) )/2
  69.       CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  70.  
  71.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  72.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  73.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  74.       CALL KFINSO(NF,NF1,KA,IM,KH)
  75.       KH(1) = ( KG(1)/2 + KH(1) )/2
  76.       KH(2) = ( KG(2)/2 + KH(2) )/2
  77.       CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  78.  
  79.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  80.       CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  81.       CALL KFINSO(NF1,NF2,KA,IM,KG)
  82.       CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  83.         ENDIF
  84.       ELSE
  85.         IF (NFA(NA2).EQ.3) THEN
  86.         NF = IFA(3,NA2)
  87. C     WRITE(6,*) ' KREMP2F CAS 3 NF ',NF
  88. C
  89. C   FACE 1 ARETES 1 2 3
  90. C
  91.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  92.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  93.       CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  94.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  95.       CALL KFINSO(NF2,NF,KA,IM,KH)
  96.       KG(1) = ( KG(1)/3 + KH(1) )/2
  97.       KG(2) = ( KG(2)/3 + KH(2) )/2
  98.       CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  99.  
  100.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  101.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  102.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  103.       CALL KFINSO(NF,NF1,KA,IM,KH)
  104.       KH(1) = ( KG(1)/2 + KH(1) )/2
  105.       KH(2) = ( KG(2)/2 + KH(2) )/2
  106.       CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  107.  
  108.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  109.       CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  110.       CALL KFINSO(NF1,NF2,KA,IM,KG)
  111.       CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  112.  
  113.         ELSE
  114. C
  115. C   FACE 1 ARETES 1 2 3
  116. C
  117.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  118.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  119.       CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  120.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  121.       CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  122. C
  123. C   FACE 2 ARETES 1 2
  124. C
  125.  
  126.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  127.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  128.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  129.       CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  130. C
  131.         ENDIF
  132.       ENDIF
  133.  
  134.       RETURN
  135.       END
  136.  
  137.  
  138.  

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