Télécharger la plaquette Cast3M


fr en

Télécharger chmkmd.eso

Retour à la liste

Numérotation des lignes : 

chmkmd

  1. C CHMKMD    SOURCE    CHAT      05/01/12    21:59:17     5004
  2.       SUBROUTINE CHMKMD(IDSCHI,LGKMOD,LGKTMP,ICOTY3,LTMP,TMP,TMPNEW,
  3.      * XMU,XMUNEW,GNEW)
  4. C========================================================================
  5. C
  6. C OBJET: MODIFICATION DES LOGK DE XMU A XMUNEW ET DE TMP A TMPNEW
  7. C               issu de TRIOEF (TRKMOD)
  8. C
  9. C
  10. C DEMARCHE: 1. GK(TMP,XMMU)->GK(TMP,XMU=0)
  11. C           2. GK(TMP,XMU=0)->GK(TMPNEW,XMU=0)
  12. C           3. GK(TMPNEW,XMU=0)->GK(TMPNEW,XMUNEW)
  13. C
  14. C APPEL DE TRTMPD POUR LTMP=1 (1IERE APPROXIMATION "D'ULICH")
  15. C APPEL DE TRTMPB POUR LTMP=2 (2IEME APPROXIMATION "D'ULICH")
  16. C TMP ET TMPNEW NE DOIVENT PAS ETRE TROP ELOIGNE DU DOMAINE DE VALIDITE
  17. C DES DONNEES THERMOCHIMIQUES
  18. C
  19. C APPEL DE CHMTMS POUR LTMP=0 (METHODE DES POLYNOMES)
  20. C
  21. C XMU ET XMUNEW DOIVENT ETRE <0.5 ETANT DONNEE LA METHODE DE CORRECTION
  22. C DE LA FORCE IONIQUE IMPLANTEE
  23. C
  24. C
  25. C========================================================================
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8(A-H,O-Z)
  28. -INC SMLENTI
  29.       POINTEUR ICOTY3.MLENTI
  30. C
  31.       SEGMENT IDSCHI
  32.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  33.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  34.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  35.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  36.       ENDSEGMENT
  37.       SEGMENT LGKMOD
  38.            REAL*8 DELH0(NYDIM),DELCP0(NYDIM)
  39.       ENDSEGMENT
  40.       SEGMENT LGKTMP
  41.            INTEGER NUMT(NYDIM),NTVT(NYDIM)
  42.            REAL*8 TMIMA(NYDIM,NT)
  43.            REAL*8 POLYT(NYDIM,NT4),TGKLU(NYDIM,NT)
  44.       ENDSEGMENT
  45. *
  46. C
  47. C
  48. C     WRITE(6,*)' XMUNEW,XMU,TMPNEW,TMP',XMUNEW,XMU,TMPNEW,TMP,ltmp
  49.       IF (XMUNEW.EQ.XMU.AND.TMPNEW.EQ.TMP) GOTO 1000
  50. C
  51. C
  52. *     WRITE(6,*)'ICOTYP3=',ICOTY3
  53.       XMU1=XMUNEW
  54.       IF (XMU.EQ.0.D0) GOTO 1020
  55.       IF (TMPNEW.NE.TMP) GOTO 1010
  56. C
  57.       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  58.       GOTO 1000
  59. C
  60. 1010  CONTINUE
  61.       XMUNEW=0.D0
  62.       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  63. 1020  CONTINUE
  64. CBRUNO
  65.       IF (LTMP.EQ.0) CALL CHMTMS(IDSCHI,LGKTMP,ICOTY3,TMP,TMPNEW)
  66.       IF (LTMP.EQ.1) CALL CHMTMD(IDSCHI,LGKMOD,ICOTY3,TMP,TMPNEW)
  67.       IF (LTMP.EQ.2) CALL CHMTMB(IDSCHI,LGKMOD,ICOTY3,TMP,TMPNEW)
  68. *
  69.       TMP=TMPNEW
  70. C
  71. C
  72.       XMUNEW=XMU1
  73.       IF (XMUNEW.EQ.0.D0) GOTO 1000
  74. C
  75.       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  76. C
  77. 1000  CONTINUE
  78. C
  79.       RETURN
  80.       END
  81.  
  82.  
  83.  
  84.  
  85.  

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