Esope source files

   1 : C TRIHI2    SOURCE    CHAT      05/01/13    03:47:03     5004           
   2 : C=======================================================================
   3 : C
   4 :       SUBROUTINE TRIHI2(ilent1,NHIST,IT,JINF,TP0,ZA0)
   5 : C
   6 : C=======================================================================
   7 : C
   8 : C    Calcul de transformations de phases
   9 : C    appelee par VOISI2
  10 : C 
  11 : C    nhist     nombre d'histoires thermiques
  12 : C    it        temperature
  13 : C    jinf      indice du premier point trouve
  14 : C    tp0,za0   coordonnees du point a interpoler
  15 : C
  16 : C    RECHERCHE DES 4 POINTS LES PLUS PETITS D'UNE LISTE
  17 : C    AYANT UN MINIMUM UNIQUE, AVEC UTILISATION D'UNE SOLUTION
  18 : C    INITIALE ET RECHERCHE FINALE PAR BISSECTION,
  19 : C    INSPIRE DES NUMERICAL RECIPES IN FORTRAN (p 110),
  20 : C
  21 : C    routines appelees
  22 : C       DIST    norme euclidienne
  23 : C
  24 : C    MM, LE 10/07/1998
  25 : C
  26 : C=======================================================================
  27 : C
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8(A-H,O-Z)
  30 : C
  31 : C
  32 : C
  33 :       JOB=JINF
  34 :       INC=1
  35 :       JOBS=JOB+3
  36 :       IF (JOB.LT.1.OR.JOBS.GT.NHIST) THEN
  37 :          JINF=1
  38 :          JSUP=NHIST-3
  39 :          GOTO 3
  40 :       ENDIF
  41 : C
  42 :       DJOB=DIST9(ILENT1,IT,JOB,TP0,ZA0)
  43 :       DJOBS=DIST9(ILENT1,IT,JOBS,TP0,ZA0)
  44 :       IF (DJOBS.EQ.DJOB) THEN
  45 :          JINF=JOB
  46 :          RETURN
  47 :       ENDIF
  48 : C
  49 :       IF (DJOBS.LT.DJOB) THEN
  50 :  1       JOB=JOB+INC
  51 :          JOBS=JOB+3
  52 :          IF (JOBS.GT.NHIST) THEN
  53 :             JINF=JOB-INC

  54 :             JSUP=NHIST-3
  55 :             GOTO 3
  56 :          ENDIF
  57 :          DJOB=DIST9(ILENT1,IT,JOB,TP0,ZA0)
  58 :          DJOBS=DIST9(ILENT1,IT,JOBS,TP0,ZA0)
  59 :          IF (DJOBS.LT.DJOB) THEN
  60 :             INC=INC+INC
  61 :             GOTO 1
  62 :          ENDIF
  63 :          JINF=JOB-INC

  64 :          JSUP=JOB
  65 : C
  66 :       ELSE
  67 :  2       JOB=JOB-INC

  68 :          JOBS=JOB+3
  69 :          IF (JOB.LT.1) THEN
  70 :             JINF=1
  71 :             JSUP=JOB+INC
  72 :             GOTO 3
  73 :          ENDIF
  74 :          DJOB=DIST9(ILENT1,IT,JOB,TP0,ZA0)
  75 :          DJOBS=DIST9(ILENT1,IT,JOBS,TP0,ZA0)
  76 :          IF (DJOBS.GT.DJOB) THEN
  77 :             INC=INC+INC
  78 :             GOTO 2
  79 :          ENDIF
  80 :          JINF=JOB
  81 :          JSUP=JOB+INC
  82 :       ENDIF
  83 : C
  84 :  3    JD=JSUP-JINF
  85 :       IF (JD.LE.1) THEN
  86 :          DINF=DIST9(ILENT1,IT,JINF,TP0,ZA0)
  87 :          JSUPS=JSUP+3
  88 :          DSUPS=DIST9(ILENT1,IT,JSUPS,TP0,ZA0)
  89 :          IF (DINF.GE.DSUPS) JINF=JSUP
  90 :          RETURN
  91 :       ENDIF
  92 :       JM=(JINF+JSUP)/2
  93 :       JMS=JM+3
  94 :       DJM=DIST9(ILENT1,IT,JM,TP0,ZA0)
  95 :       DJMS=DIST9(ILENT1,IT,JMS,TP0,ZA0)
  96 :       IF (DJMS.GT.DJM) THEN
  97 :          JSUP=JM
  98 :       ELSE
  99 :          JINF=JM
 100 :       ENDIF
 101 :       GOTO 3
 102 :       END
 103 :  
 104 :