Télécharger krcomb.eso

Retour à la liste

Numérotation des lignes :

  1. C KRCOMB SOURCE CB215821 16/04/21 21:17:35 8920
  2. SUBROUTINE KRCOMB (K1,SP1,SHC3D,SKFACE,SKBUFF,EXTINC)
  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 FACGEN
  8. C
  9. C RECOMBINAISON
  10. C -------------
  11. C CONTRIBUTION DUE A UN PATCH DONNE
  12. C----------------------------------------------------------------------
  13. -INC TFFOR3D
  14. C
  15. MFACE = FF1(/1)
  16. DO 400 K = 1,MFACE
  17. FF1(K) = 0.
  18. 400 CONTINUE
  19.  
  20. NC = 0
  21.  
  22. IF(EXTINC.GT.1D-3) THEN
  23. C
  24. C milieu absorbant
  25.  
  26. DO 500 NF = 1,KFC
  27. DO 501 I = 1,NRES
  28. DO 502 J = 1,NRES
  29.  
  30. NTY = NTYP(NF,I,J)
  31. IF ( (NTY.NE.0) .AND. (PSC(NF,I,J).GT.-1.) ) THEN
  32. NC = NC + 1
  33. PROD = PSC(NF,I,J)*G(I,J)
  34. DO 503 KT=1,NTY
  35. K = NUMF(NF,KT,I,J)
  36. FF1(K) = FF1(K) + (PROD/NTY)*EXP(-EXTINC*ZB(NF,I,J))
  37. 503 CONTINUE
  38. ENDIF
  39. 502 CONTINUE
  40. 501 CONTINUE
  41. 500 CONTINUE
  42.  
  43. ELSE
  44. C
  45. C milieu transparent
  46.  
  47. DO 600 NF = 1,KFC
  48. DO 601 I = 1,NRES
  49. DO 602 J = 1,NRES
  50.  
  51. NTY = NTYP(NF,I,J)
  52. IF ( (NTY.NE.0) .AND. (PSC(NF,I,J).GT.-1.) ) THEN
  53. NC = NC + 1
  54. PROD = PSC(NF,I,J)*G(I,J)
  55. DO 603 KT=1,NTY
  56. K = NUMF(NF,KT,I,J)
  57. FF1(K) = FF1(K) + PROD/NTY
  58. 603 CONTINUE
  59. ENDIF
  60. 602 CONTINUE
  61. 601 CONTINUE
  62. 600 CONTINUE
  63.  
  64. ENDIF
  65.  
  66. NCELL(K1) = NC
  67.  
  68. CALL UTSOMM(FF1,MFACE,FFT)
  69. IF (KIMP.GE.4) THEN
  70. WRITE(6,1000) K1,SP1,NCELL(K1),FFT
  71. 1000 FORMAT(1X,' K1 ',I4,' SP1 ',E12.5,'NCELL ',I6,' FFT ',F10.5)
  72. ENDIF
  73. C
  74. DO 700 K = 1,MFACE
  75. FF1(K) = SP1 * FF1(K)
  76. 700 CONTINUE
  77. C
  78. RETURN
  79. END
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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