Télécharger krem1g.eso

Retour à la liste

Numérotation des lignes :

  1. C KREM1G SOURCE CHAT 05/01/13 01:06:09 5004
  2. SUBROUTINE KREM1G(K2,NF1,NF2,NF3,NA1,NA2,NA3
  3. * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C----------------------------------------------------------------------
  7. C Calcul des facteurs de forme en 3D
  8. C Sp appele par KPROJG
  9. C UNE SEULE FACE NF1 = NF2 = NF3
  10. C LE NOMBRE DE CELLULES DE PROJECTION DE L'ARETE NA EST NCEL(1,NA)
  11. C CF. KREMPA
  12. C
  13. C----------------------------------------------------------------------
  14. C
  15. DIMENSION U2(4),KG(2),KH(2)
  16. -INC TFFOR3D
  17. SEGMENT SKSEGM
  18. INTEGER KKSEGM(2,NSEGM)
  19. ENDSEGMENT
  20. C
  21. C DESCRIPTION DES ARETES
  22. C
  23. SEGMENT SKCEL
  24. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  25. REAL*8 RMAX
  26. ENDSEGMENT
  27. C
  28. C--------------------------------------------------------------------
  29. C
  30. NR = IR(/1)
  31. C UNE SEULE FACE
  32. C --------------
  33. C
  34. CALL KINITB(KBCEL,NR,NR,KG,NG)
  35. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  36. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  37. CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  38. KH(1) = ( KG(1) + 1)/NG
  39. KH(2) = ( KG(2) + 1)/NG
  40.  
  41. C
  42. C WRITE(6,*) ' KREM1G NCEL ',NCEL(1,NA1),NCEL(1,NA2),NCEL(1,NA3)
  43.  
  44. IF(NCEL(1,NA1).LE.2.OR.NCEL(1,NA2).LE.2.OR.NCEL(1,NA3).LE.2) THEN
  45.  
  46. IF (KIMP.GE.4) THEN
  47. WRITE(6,*) ' NF KG ',NF1,KH(1),KH(2), ' TRIANGLE APLATI ** '
  48. DO 2 I =1,NRES
  49. WRITE(6,*) (KBCEL(I,J),J=1,NRES)
  50. 2 CONTINUE
  51. ENDIF
  52.  
  53. ELSEIF (KBCEL(KH(1),KH(2)).EQ.1) THEN
  54.  
  55. IF (KIMP.GE.4) THEN
  56. WRITE(6,*) ' NF KG ',NF1,KH(1),KH(2), ' CONTOUR ** '
  57. DO 3 I =1,NRES
  58. WRITE(6,*) (KBCEL(I,J),J=1,NRES)
  59. 3 CONTINUE
  60. ENDIF
  61. ELSE
  62.  
  63. CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  64.  
  65. ENDIF
  66. C|
  67. C
  68. RETURN
  69. END
  70.  
  71.  
  72.  

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