Télécharger la plaquette Cast3M


fr en

Télécharger krem3g.eso

Retour à la liste

Numérotation des lignes : 

krem3g

  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
  48.       CALL KINITB(KBCEL,NR,NR,KG,NG)
  49.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  50.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  51.       CALL KFINSO(NF2,NF3,KA,IM,KH)
  52.       KG(1) = ( KG(1)/2 + KH(1) )/2
  53.       KG(2) = ( KG(2)/2 + KH(2) )/2
  54.       CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  55.  
  56.       CALL KINITB(KBCEL,NR,NR,KG,NG)
  57.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  58.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  59.       CALL KFINSO(NF1,NF3,KA,IM,KH)
  60.       KG(1) = ( KG(1)/2 + KH(1) )/2
  61.       KG(2) = ( KG(2)/2 + KH(2) )/2
  62.       CALL KREMPI(NIN,K2,KG,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  63.  
  64.       CALL KINITB(KBCEL,NR,NR,KG,NG)
  65.       CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  66.       CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  67.       CALL KFINSO(NF1,NF2,KA,IM,KH)
  68.       KG(1) = ( KG(1)/2 + KH(1) )/2
  69.       KG(2) = ( KG(2)/2 + KH(2) )/2
  70.       CALL KREMPI(NIN,K2,KG,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  71.  
  72.       ELSE
  73. C
  74. C     IL EXISTE UNE FACE GENEREE
  75. C     ---------------------------
  76. C
  77.       IF (NFA(NA2).EQ.3) THEN
  78.       KC1(1) = ICOO(1,NS1)
  79.       KC1(2) = ICOO(2,NS1)
  80.       CALL KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1
  81.      -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  82.       ENDIF
  83. C
  84.       IF (NFA(NA3).EQ.3) THEN
  85.       KC1(1) = ICOO(1,NS2)
  86.       KC1(2) = ICOO(2,NS2)
  87.       CALL KREM3F(K2,KG,NG,KC1,NA3,NF3,NF1,NF2,NA1,NA2
  88.      -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  89.       ENDIF
  90.  
  91.       IF (NFA(NA1).EQ.3) THEN
  92.       KC1(1) = ICOO(1,NS3)
  93.       KC1(2) = ICOO(2,NS3)
  94.       CALL KREM3F(K2,KG,NG,KC1,NA1,NF1,NF2,NF3,NA2,NA3
  95.      -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  96.       ENDIF
  97.  
  98.       ENDIF
  99. C
  100.       RETURN
  101.       END
  102.  
  103.  
  104.  

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