Numérotation des lignes :

C KRCOMB    SOURCE    CB215821  16/04/21    21:17:35     8920      SUBROUTINE KRCOMB (K1,SP1,SHC3D,SKFACE,SKBUFF,EXTINC)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C----------------------------------------------------------------------C Calcul des facteurs de forme en 3DC Sp appele par FACGENCC     RECOMBINAISONC     -------------C     CONTRIBUTION DUE A UN PATCH DONNEC-----------------------------------------------------------------------INC TFFOR3DC      MFACE = FF1(/1)      DO 400 K = 1,MFACE      FF1(K) = 0. 400  CONTINUE       NC = 0       IF(EXTINC.GT.1D-3) THENCC     milieu absorbant       DO 500 NF = 1,KFC      DO 501 I = 1,NRES      DO 502 J = 1,NRES          NTY = NTYP(NF,I,J)         IF ( (NTY.NE.0) .AND. (PSC(NF,I,J).GT.-1.) ) THEN           NC = NC + 1           PROD  =  PSC(NF,I,J)*G(I,J)             DO 503 KT=1,NTY              K = NUMF(NF,KT,I,J)              FF1(K) = FF1(K) + (PROD/NTY)*EXP(-EXTINC*ZB(NF,I,J)) 503         CONTINUE         ENDIF 502  CONTINUE 501  CONTINUE 500  CONTINUE       ELSECC     milieu transparent       DO 600 NF = 1,KFC      DO 601 I = 1,NRES      DO 602 J = 1,NRES          NTY = NTYP(NF,I,J)         IF ( (NTY.NE.0) .AND. (PSC(NF,I,J).GT.-1.) ) THEN           NC = NC + 1           PROD  =  PSC(NF,I,J)*G(I,J)             DO 603 KT=1,NTY              K = NUMF(NF,KT,I,J)              FF1(K) = FF1(K) + PROD/NTY 603         CONTINUE         ENDIF 602  CONTINUE 601  CONTINUE 600  CONTINUE       ENDIF       NCELL(K1) = NC       CALL UTSOMM(FF1,MFACE,FFT)      IF (KIMP.GE.4) THEN      WRITE(6,1000) K1,SP1,NCELL(K1),FFT 1000 FORMAT(1X,' K1 ',I4,' SP1 ',E12.5,'NCELL ',I6,' FFT ',F10.5)      ENDIFC      DO 700 K = 1,MFACE      FF1(K) = SP1 * FF1(K) 700  CONTINUEC      RETURN      END

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