Numérotation des lignes :

C KREMPI    SOURCE    CB215821  16/04/21    21:17:36     8920      SUBROUTINE KREMPI (NINS,K2,KG,NARL,NF,C,U2,SHC3D,SKCEL,SKBUFF)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C----------------------------------------------------------------------C Calcul des facteurs de forme en 3DC Sp appele par la famille KREMxGCC     DETERMINATION DE l'INTERIEUR D'UN CONTOURC----------------------------------------------------------------------      DIMENSION KG(2),U2(1)-INC TFFOR3D      SEGMENT SKCEL      INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)      REAL*8   RMAX      ENDSEGMENTC      NRMAX = NINT(RMAX * IINT(/2))      NSTAC = IS(/1)      IF(NARL.EQ.3) THEN         KG(1) = (KG(1)+1) /NARL         KG(2) = (KG(2)+1) /NARL      ELSE         KG(1) = KG(1) /NARL         KG(2) = KG(2) /NARL      ENDIF       IF( KBCEL(KG(1),KG(2)).EQ.0) THEN           CALL KPARC(KG,KBCEL,NRES,NINS,IINT,NRMAX,IS,JS,NSTAC)      IF(NINS.EQ.NRMAX) THEN       NINS = 0      IF (KIMP.GE.4) THEN       WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS,' EXTERIEUR '      ENDIF       ELSE      IF (KIMP.GE.4) THEN       WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS      ENDIF      ENDIF       ELSE          NINS = 0      IF (KIMP.GE.4) THEN       WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),' NINS ',NINS,' CONTOUR '      ENDIF      ENDIF       IF (KIMP.GE.4) THEN      DO 2 I = 1,NRES      WRITE(6,*) (KBCEL(I,J),J=1,NRES) 2    CONTINUE      ENDIF       IF (NINS.NE.0) THEN           DO 404 L = 1,NINS              I = IINT(1,L)              J = IINT(2,L)           IF (PSC(NF,I,J).GT.-1.) THEN              B = 0.              DO 406  IES = 1,KES              B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J) 406          CONTINUE              IF (ABS(B).GT.0.0001) THEN                 Z = - C / B                 IF (Z.LT.ZB(NF,I,J).AND.Z.GT.1E-4)  THEN                    ZB(NF,I,J) = Z                    NUMF(NF,1,I,J) = K2                    NTYP(NF,I,J) = 1                 ENDIF              ENDIF           ENDIF 404        CONTINUE      ENDIF      RETURN      END

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