1 : C KRCOM2 SOURCE CHAT 05/01/13 01:06:03 5004 2 : SUBROUTINE KRCOM2 (K1,SP1,SHC2D,SKFAC2,SKBUF2,SKRESO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C 6 : C RECOMBINAISON 7 : C ------------- 8 : C CONTRIBUTION DUE A UN PATCH DONNE 9 : 10 : C----------------------------------------------------------------------- 11 : SEGMENT SKRESO 12 : INTEGER KFC,NRES,KES,KIMP 13 : ENDSEGMENT 14 : C KFC : NOMBRE DE FACES H.C 15 : C NRES: RESOLUTION 16 : C KES : DIM ESPACE 17 : C KIMP: IMPRESSION 18 : C----------------------------------------------------------------------- 19 : C----------------------------------------------------------------------- 20 : SEGMENT SHC2D 21 : INTEGER IR(NR),KA(NFC),IM(NFC,NFC) 22 : INTEGER KRO(NFC,NES),KSI(NFC,NES) 23 : REAL*8 V(NES,NR),G(NR) 24 : ENDSEGMENT 25 : 26 : C DESCRIPTION DU H.C DE PROJECTION 27 : C -------------------------------- 28 : C V : DIRECTION UNITAIRE DES CELLULES 29 : C G : FACTEUR DE FORME ASSOCIE 30 : C IR: CORRESPONDANCE 31 : C KRO , KSI : POUR LE CHANGEMENT DE REPERE 32 : C IM : REFERENCE 33 : C NR : RESOLUTION 34 : C NFC : NOMBRE DE FACES 35 : C----------------------------------------------------------------------- 36 : SEGMENT SKFAC2 37 : INTEGER NUK(MS,MFACE),KPATCH(MFACE) 38 : INTEGER NCELL(MFACE) 39 : REAL*8 U(3,MFACE),S(MFACE) 40 : REAL*8 FF1(MFACE) 41 : ENDSEGMENT 42 : SEGMENT IPATCH 43 : REAL*8 GP(MSP,NPATCH),SP(NPATCH) 44 : ENDSEGMENT 45 : C 46 : C DESCRIPTION DES ELEMENTS 47 : C ------------------------ 48 : C MFACE : NOMBRE DE FACES 49 : C NUK : CONNECTIVITES 50 : C U : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT 51 : C S : SURFACE 52 : C KVU : VISIBILITE A PRIORI 53 : C FF : FACTEURS DE FORME 54 : C FF1 : TRAVAIL 55 : C NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT 56 : C KPATCH: POINTEUR SUR IPATCH 57 : C NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE) 58 : C GP : COORDONNEES DES POINTS 59 : C SP : ET SURFACES 60 : C----------------------------------------------------------------------- 61 : SEGMENT SKBUF2 62 : INTEGER NUMF(NFC,NOC,NR),NTYP(NFC,NR) 63 : REAL*8 ZB(NFC,NR),PSC(NFC,NR) 64 : ENDSEGMENT 65 : C 66 : C BUFFER ASSOCIE AU H.C 67 : C --------------------- 68 : C NUMF : INDICE DE LE DERNIERE FACE RENCONTREE 69 : C NTYP : TYPES ASSOCIES 70 : C ZB : PROFONDEUR 71 : C PSC : PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE) 72 : C----------------------------------------------------------------------- 73 : MFACE = FF1(/1) 74 : DO 400 K = 1,MFACE 75 : FF1(K) = 0. 76 : 400 CONTINUE 77 : 78 : NC = 0 79 : DO 500 NF = 1,KFC 80 : DO 501 I = 1,NRES 81 : 82 : NTY = NTYP(NF,I) 83 : IF ( (NTY.NE.0) .AND. (PSC(NF,I).GT.-1.) ) THEN 84 : NC = NC + 1 85 : PROD = PSC(NF,I)*G(I) 86 : DO 100 KT=1,NTY 87 : K = NUMF(NF,KT,I) 88 : FF1(K) = FF1(K) + PROD/NTY 89 : 100 CONTINUE 90 : ENDIF 91 : 501 CONTINUE 92 : 500 CONTINUE 93 : NCELL(K1) = NC 94 : 94 : CALL UTSOMM(FF1,MFACE,FFT) 95 : IF (KIMP.GE.4) THEN 96 : WRITE(6,1000) K1,SP1,NCELL(K1),FFT 97 : 1000 FORMAT(1X,' K1 ',I4,' SP1 ',E12.5,' NCELL ',I6,' FFT ',F10.5) 98 : ENDIF 99 : 100 : DO 600 K = 1,MFACE 101 : FF1(K) = SP1 * FF1(K) 102 : 600 CONTINUE 103 : C 104 : RETURN 105 : END 106 : 107 : 108 :
© Cast3M 2003 - All rights reserved.
Disclaimer