1 : C KREMS2 SOURCE CHAT 05/01/13 01:06:33 5004 2 : SUBROUTINE KREMS2 (K2,NF,I,C,U2,SHC2D,SKBUF2,SKRESO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C 6 : C CELLULES-SOMMETS 7 : C ---------------- 8 : C----------------------------------------------------------------------- 9 : SEGMENT SKRESO 10 : INTEGER KFC,NRES,KES,KIMP 11 : ENDSEGMENT 12 : C KFC : NOMBRE DE FACES H.C 13 : C NRES: RESOLUTION 14 : C KES : DIM ESPACE 15 : C KIMP: IMPRESSION 16 : C----------------------------------------------------------------------- 17 : C----------------------------------------------------------------------- 18 : SEGMENT SHC2D 19 : INTEGER IR(NR),KA(NFC),IM(NFC,NFC) 20 : INTEGER KRO(NFC,NES),KSI(NFC,NES) 21 : REAL*8 V(NES,NR),G(NR) 22 : ENDSEGMENT 23 : 24 : C DESCRIPTION DU H.C DE PROJECTION 25 : C -------------------------------- 26 : C V : DIRECTION UNITAIRE DES CELLULES 27 : C G : FACTEUR DE FORME ASSOCIE 28 : C IR: CORRESPONDANCE 29 : C KRO , KSI : POUR LE CHANGEMENT DE REPERE 30 : C IM : REFERENCE 31 : C NR : RESOLUTION 32 : C NFC : NOMBRE DE FACES 33 : C----------------------------------------------------------------------- 34 : SEGMENT SKBUF2 35 : INTEGER NUMF(NFC,NOC,NR),NTYP(NFC,NR) 36 : REAL*8 ZB(NFC,NR),PSC(NFC,NR) 37 : ENDSEGMENT 38 : C 39 : C BUFFER ASSOCIE AU H.C 40 : C --------------------- 41 : C NUMF : INDICE DE LE DERNIERE FACE RENCONTREE 42 : C NTYP : TYPES ASSOCIES 43 : C ZB : PROFONDEUR 44 : C PSC : PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE) 45 : C----------------------------------------------------------------------- 46 : DIMENSION U2(1),KG(2) 47 : C 48 : NOC = NUMF(/2) 49 : C 50 : IF (PSC(NF,I).GT.-1.) THEN 51 : B = 0. 52 : DO 40 IES = 1,KES 53 : B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I) 54 : 40 CONTINUE 55 : IF (DABS(B).GT.0.0001) THEN 56 : Z = - C / B 57 : DFF = Z - ZB(NF,I) 58 : DIFF = DABS(DFF) 59 : NTY = NTYP(NF,I) 60 : IF (DIFF.LT.1E-4.AND.NTY.LT.NOC) THEN 61 : DO 100 KT=1,NTY 62 : K = NUMF(NF,KT,I) 63 : IF (K.EQ.K2) GOTO 101 64 : 100 CONTINUE 65 : NTY = NTY + 1 66 : NUMF(NF,NTY,I) = K2 67 : NTYP(NF,I) = NTY 68 : 101 CONTINUE 69 : ELSE 70 : IF (DFF.LT.-1E-3.AND.Z.GT.1E-4) THEN 71 : ZB(NF,I) = Z 72 : NUMF(NF,1,I) = K2 73 : NTYP(NF,I) = 1 74 : ENDIF 75 : ENDIF 76 : ENDIF 77 : ENDIF 78 : 79 : RETURN 80 : END 81 :
© Cast3M 2003 - All rights reserved.
Disclaimer