Esope source files

   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
  56 :       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  57 :       GOTO 1000                                                                 
  58 : C
  59 : 1010  CONTINUE
  60 :       XMUNEW=0.D0
  60 :       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  61 : 1020  CONTINUE                                                                  
  62 : CBRUNO
  62 :       IF (LTMP.EQ.0) CALL CHMTMS(IDSCHI,LGKTMP,ICOTY3,TMP,TMPNEW)
  62 :       IF (LTMP.EQ.1) CALL CHMTMD(IDSCHI,LGKMOD,ICOTY3,TMP,TMPNEW)
  62 :       IF (LTMP.EQ.2) CALL CHMTMB(IDSCHI,LGKMOD,ICOTY3,TMP,TMPNEW)
  63 : *
  64 :       TMP=TMPNEW
  65 : C
  66 : C
  67 :       XMUNEW=XMU1                                                               
  68 :       IF (XMUNEW.EQ.0.D0) GOTO 1000
  69 : C
  69 :       CALL CHMMOD(IDSCHI,XMU,XMUNEW,TMPNEW,GNEW)
  70 : C
  71 : 1000  CONTINUE                                                                  
  72 : C                                                                               
  73 :       RETURN                                                                    
  74 :       END                                                                       
  75 :  
  76 :  
  77 :  
  78 :