Télécharger la plaquette Cast3M


fr en

Télécharger krem3f.eso

Retour à la liste

Numérotation des lignes : 

krem3f

  1. C KREM3F    SOURCE    PV        22/04/21    21:15:06     11344          
  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),U2(*)
  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.  
  25.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  26.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  27.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  28.       CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  29.  
  30.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  31.       CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  32.       CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  33.       CALL KREMPI(NIN,K2,KG,NG,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  34.  
  35.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  36.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  37.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  38.       KH(1) = (KG(1)/2 + KC1(1))/2
  39.       KH(2) = (KG(2)/2 + KC1(2))/2
  40.       NG = 0
  41.       KG(1) = 0
  42.       KG(2) = 0
  43.       CALL KREMPA(K2,KG,NG,NFN,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  44.       KH(1) = (KG(1) + KH(1))/2
  45.       KH(2) = (KG(2) + KH(2))/2
  46.       CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  47.  
  48.       ELSE
  49.       NFF = IFA(3,NA2)
  50.  
  51. C     WRITE(6,*) ' KREMPY NFF ',NFF
  52.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  53.       CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  54.       CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  55.       CALL KFINSO(NF1,NF3,KA,IM,KH)
  56.       CALL KFINSO(NFF,NF3,KA,IM,KG)
  57.       KH(1) = (KG(1) + KH(1))/2
  58.       KH(2) = (KG(2) + KH(2))/2
  59.       CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  60.  
  61.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  62.       CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  63.       CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  64.       CALL KFINSO(NF1,NF2,KA,IM,KH)
  65.       CALL KFINSO(NFF,NF2,KA,IM,KG)
  66.       KH(1) = (KG(1) + KH(1))/2
  67.       KH(2) = (KG(2) + KH(2))/2
  68.       CALL KREMPI(NIN,K2,KH,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  69.  
  70.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  71.       CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  72.       CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  73.       CALL KFINSO(NF2,NF3,KA,IM,KH)
  74.       KH(1) = (KG(1)/2 + KH(1))/2
  75.       KH(2) = (KG(2)/2 + KH(2))/2
  76.       CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  77. C
  78.       CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  79.       CALL KREMPA(K2,KG,NG,NFF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  80.       CALL KFINSO(NF2,NF3,KA,IM,KG)
  81.       CALL KREMPI(NIN,K2,KG,1,NFF,C,U2,SHC3D,SKCEL,SKBUFF)
  82.       ENDIF
  83.  
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  
  89.  

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