Télécharger la plaquette Cast3M


fr en

Télécharger kprojg.eso

Retour à la liste

Numérotation des lignes : 

kprojg

  1. C KPROJG    SOURCE    CHAT      05/01/13    01:05:17     5004
  2.       SUBROUTINE KPROJG(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3
  3.      * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP,KERR)
  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 KPROJF
  9. C
  10. C
  11. C----------------------------------------------------------------------
  12. C
  13.       DIMENSION U2(4)
  14. C
  15. -INC TFFOR3D
  16.       SEGMENT SKSEGM
  17.         INTEGER  KKSEGM(2,NSEGM)
  18.       ENDSEGMENT
  19. C
  20. C     DESCRIPTION DES ARETES
  21. C
  22.       SEGMENT SPROJP
  23.       INTEGER  KF(NPT),ICOO(2,NPT)
  24.       REAL*8   XR(3,NPT)
  25.       ENDSEGMENT
  26.       SEGMENT SKCEL
  27.       INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  28.       REAL*8   RMAX
  29.       ENDSEGMENT
  30. C
  31. C--------------------------------------------------------------------
  32.        NR = IR(/1)
  33. C
  34.             IF(NF1.EQ.NF2) THEN
  35.               IF(NF2.EQ.NF3) THEN
  36. C
  37. C     1  FACE
  38. C     -------
  39. C
  40.       CALL KREM1G(K2,NF1,NF2,NF3,NA1,NA2,NA3
  41.      * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  42.               ELSE
  43. C
  44. C      2 FACES DIFFERENTES NON PARALLELES
  45. C      ----------------------------------
  46. C
  47.       IF (KA(NF2).EQ.KA(NF3)) GOTO 500
  48.       CALL KREM2G(K2,NF2,NF3,NA2,NA3,NA1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  49.               ENDIF
  50.  
  51.                ELSE
  52.            IF (NF3.EQ.NF2) THEN
  53.       IF (KA(NF1).EQ.KA(NF2)) GOTO 500
  54.       CALL KREM2G(K2,NF2,NF1,NA1,NA3,NA2,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  55.  
  56.              ELSE
  57.            IF (NF3.EQ.NF1) THEN
  58.       IF (KA(NF1).EQ.KA(NF2)) GOTO 500
  59.       CALL KREM2G(K2,NF1,NF2,NA1,NA2,NA3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  60.  
  61.            ELSE
  62. C
  63. C   3 FACES DIFFERENTES NON PARALLELES
  64. C   ----------------------------------
  65.  
  66.       IF (KA(NF1).EQ.KA(NF2)) GOTO 600
  67.       IF (KA(NF2).EQ.KA(NF3)) GOTO 600
  68.       IF (KA(NF3).EQ.KA(NF1)) GOTO 600
  69.       CALL KREM3G(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3
  70.      * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP)
  71. C
  72.         ENDIF
  73.              ENDIF
  74.              ENDIF
  75.       KERR = 0
  76.       RETURN
  77. C
  78.  500  CONTINUE
  79.       KERR =2
  80.       RETURN
  81.  600  CONTINUE
  82.       KERR =3
  83.       RETURN
  84.       END
  85.  
  86.  
  87.  

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