Télécharger la plaquette Cast3M


fr en

Télécharger krempi.eso

Retour à la liste

Numérotation des lignes : 

krempi

  1. C KREMPI    SOURCE    CB215821  16/04/21    21:17:36     8920
  2.       SUBROUTINE KREMPI (NINS,K2,KG,NARL,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C Calcul des facteurs de forme en 3D
  7. C Sp appele par la famille KREMxG
  8. C
  9. C     DETERMINATION DE l'INTERIEUR D'UN CONTOUR
  10. C----------------------------------------------------------------------
  11.       DIMENSION KG(2),U2(1)
  12. -INC TFFOR3D
  13.       SEGMENT SKCEL
  14.       INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  15.       REAL*8   RMAX
  16.       ENDSEGMENT
  17. C
  18.       NRMAX = NINT(RMAX * IINT(/2))
  19.       NSTAC = IS(/1)
  20.       IF(NARL.EQ.3) THEN
  21.          KG(1) = (KG(1)+1) /NARL
  22.          KG(2) = (KG(2)+1) /NARL
  23.       ELSE
  24.          KG(1) = KG(1) /NARL
  25.          KG(2) = KG(2) /NARL
  26.       ENDIF
  27.  
  28.       IF( KBCEL(KG(1),KG(2)).EQ.0) THEN
  29.            CALL KPARC(KG,KBCEL,NRES,NINS,IINT,NRMAX,IS,JS,NSTAC)
  30.       IF(NINS.EQ.NRMAX) THEN
  31.        NINS = 0
  32.       IF (KIMP.GE.4) THEN
  33.        WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS,' EXTERIEUR '
  34.       ENDIF
  35.        ELSE
  36.       IF (KIMP.GE.4) THEN
  37.        WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS
  38.       ENDIF
  39.       ENDIF
  40.  
  41.       ELSE
  42.           NINS = 0
  43.       IF (KIMP.GE.4) THEN
  44.        WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),' NINS ',NINS,' CONTOUR '
  45.       ENDIF
  46.       ENDIF
  47.  
  48.       IF (KIMP.GE.4) THEN
  49.       DO 2 I = 1,NRES
  50.       WRITE(6,*) (KBCEL(I,J),J=1,NRES)
  51.  2    CONTINUE
  52.       ENDIF
  53.  
  54.       IF (NINS.NE.0) THEN
  55.            DO 404 L = 1,NINS
  56.               I = IINT(1,L)
  57.               J = IINT(2,L)
  58.            IF (PSC(NF,I,J).GT.-1.) THEN
  59.               B = 0.
  60.               DO 406  IES = 1,KES
  61.               B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J)
  62.  406          CONTINUE
  63.               IF (ABS(B).GT.0.0001) THEN
  64.                  Z = - C / B
  65.                  IF (Z.LT.ZB(NF,I,J).AND.Z.GT.1E-4)  THEN
  66.                     ZB(NF,I,J) = Z
  67.                     NUMF(NF,1,I,J) = K2
  68.                     NTYP(NF,I,J) = 1
  69.                  ENDIF
  70.               ENDIF
  71.            ENDIF
  72.  404        CONTINUE
  73.       ENDIF
  74.       RETURN
  75.       END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  

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