Télécharger la plaquette Cast3M


fr en

Télécharger k2empi.eso

Retour à la liste

Numérotation des lignes : 

k2empi

  1. C K2EMPI    SOURCE    CB215821  16/04/21    21:17:20     8920
  2.       SUBROUTINE K2EMPI (K2,NF,LMIN,LMAX,C,U2,SHC2D,SKBUF2,SKRESO)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C     DIM 2  : INTERIEU
  7. C     ON SUPPOSE LMIN < LMAX
  8. C
  9. C-----------------------------------------------------------------------
  10.       SEGMENT SKRESO
  11.       INTEGER KFC,NRES,KES,KIMP
  12.       ENDSEGMENT
  13. C     KFC : NOMBRE DE FACES H.C
  14. C     NRES: RESOLUTION
  15. C     KES : DIM ESPACE
  16. C     KIMP: IMPRESSION
  17. C-----------------------------------------------------------------------
  18. C-----------------------------------------------------------------------
  19.       SEGMENT SHC2D
  20.       INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
  21.       INTEGER KRO(NFC,NES),KSI(NFC,NES)
  22.       REAL*8  V(NES,NR),G(NR)
  23.       ENDSEGMENT
  24.  
  25. C     DESCRIPTION DU H.C DE PROJECTION
  26. C     --------------------------------
  27. C     V : DIRECTION UNITAIRE DES CELLULES
  28. C     G : FACTEUR DE FORME ASSOCIE
  29. C     IR: CORRESPONDANCE
  30. C     KRO , KSI : POUR LE CHANGEMENT DE REPERE
  31. C     IM  : REFERENCE
  32. C     NR  : RESOLUTION
  33. C     NFC : NOMBRE DE FACES
  34. C-----------------------------------------------------------------------
  35.       SEGMENT SKBUF2
  36.       INTEGER  NUMF(NFC,NOC,NR),NTYP(NFC,NR)
  37.       REAL*8   ZB(NFC,NR),PSC(NFC,NR)
  38.       ENDSEGMENT
  39. C
  40. C     BUFFER ASSOCIE AU H.C
  41. C     ---------------------
  42. C     NUMF : INDICE DE LE DERNIERE FACE RENCONTREE
  43. C     NTYP :  TYPES ASSOCIES
  44. C     ZB  : PROFONDEUR
  45. C     PSC  :  PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE)
  46. C-----------------------------------------------------------------------
  47.       DIMENSION U2(1)
  48. C
  49.       LL = LMAX-LMIN + 1
  50.       IF (KIMP.GE.4) WRITE(6,*) '  NF  NINT ',NF, LL
  51.       DO 404 I = LMIN,LMAX
  52.            IF (PSC(NF,I).GT.-1.) THEN
  53.               B = 0.
  54.               DO 406  IES = 1,KES
  55.               B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I)
  56.  406          CONTINUE
  57.               IF (ABS(B).GT.0.0001) THEN
  58.                  Z = - C / B
  59.                  IF (Z.LT.ZB(NF,I).AND.Z.GT.1E-4)  THEN
  60.                     ZB(NF,I) = Z
  61.                     NUMF(NF,1,I) = K2
  62.                     NTYP(NF,I) = 1
  63.                  ENDIF
  64.               ENDIF
  65.             ENDIF
  66.  404        CONTINUE
  67.       RETURN
  68.       END
  69.  
  70.  
  71.  
  72.  

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