1 : C KREMPI SOURCE PV 11/03/09 21:15:17 6890 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 28 : CALL KPARC(KG,KBCEL,NRES,NINS,IINT,NRMAX,IS,JS,NSTAC) 29 : IF(NINS.EQ.NRMAX) THEN 30 : NINS = 0 31 : IF (KIMP.GE.4) THEN 32 : WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS,' EXTERIEUR ' 33 : ENDIF 34 : ELSE 35 : IF (KIMP.GE.4) THEN 36 : WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS 37 : ENDIF 38 : ENDIF 39 : 40 : ELSE 41 : NINS = 0 42 : IF (KIMP.GE.4) THEN 43 : WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),' NINS ',NINS,' CONTOUR ' 44 : ENDIF 45 : ENDIF 46 : 47 : IF (KIMP.GE.4) THEN 48 : DO 2 I = 1,NRES 49 : WRITE(6,*) (KBCEL(I,J),J=1,NRES) 50 : 2 CONTINUE 51 : ENDIF 52 : 53 : IF (NINS.NE.0) THEN 54 : DO 404 L = 1,NINS 55 : I = IINT(1,L) 56 : J = IINT(2,L) 57 : IF (PSC(NF,I,J).GT.-1.) THEN 58 : B = 0. 59 : DO 406 IES = 1,KES 60 : B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J) 61 : 406 CONTINUE 62 : IF (DABS(B).GT.0.0001) THEN 63 : Z = - C / B 64 : IF (Z.LT.ZB(NF,I,J).AND.Z.GT.1E-4) THEN 65 : ZB(NF,I,J) = Z 66 : NUMF(NF,1,I,J) = K2 67 : NTYP(NF,I,J) = 1 68 : ENDIF 69 : ENDIF 70 : ENDIF 71 : 404 CONTINUE 72 : ENDIF 73 : RETURN 74 : END 75 : 76 : 77 :
© Cast3M 2003 - All rights reserved.
Disclaimer