Télécharger la plaquette Cast3M


fr en

Télécharger krem1g.eso

Retour à la liste

Numérotation des lignes : 

krem1g

  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