Télécharger la plaquette Cast3M


fr en

Télécharger trihi2.eso

Retour à la liste

Numérotation des lignes : 

trihi2

  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.  
  105.  

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