diff options
| author | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
|---|---|---|
| committer | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
| commit | 7dfcc480ba1e19bd3232349fc733caef94034292 (patch) | |
| tree | 03ee104eb8846d5cc1a981d267687a729185d3f3 /Donjon/src/DETRTR.f | |
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Donjon/src/DETRTR.f')
| -rw-r--r-- | Donjon/src/DETRTR.f | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/Donjon/src/DETRTR.f b/Donjon/src/DETRTR.f new file mode 100644 index 0000000..b014028 --- /dev/null +++ b/Donjon/src/DETRTR.f @@ -0,0 +1,59 @@ +*DECK DETRTR + SUBROUTINE DETRTR(DA,A,IA,A1,A2,A3,II1,II2,II3) +* +*---------------------------------------------------------------------- +*Purpose: +* Obtain the coordinates of a point where the interpolation is +* performed +* +*Author(s): +* ??? +* +*Parameters: +* DA +* A +* IA +* A1 +* A2 +* A3 +* II1 +* II2 +* II3 +* +*---------------------------------------------------------------------- +* + DIMENSION A(*) + CHARACTER*6 CLNAME +* + CLNAME = 'SORTR ' + DIF1 = 1000000. + DIF2 = 1000001. + DIF3 = 1000002. + II1 = 1000000 + II2 = 1000001 + II3 = 1000002 +* + DO 10 II=1,IA + DIF = ABS(DA-A(II)) + IF ( DIF .LE. DIF1 ) THEN + DIF3 = DIF2 + DIF2 = DIF1 + DIF1 = DIF + II3 = II2 + II2 = II1 + II1 = II + ELSE IF ( DIF .LE. DIF2 ) THEN + DIF3 = DIF2 + DIF2 = DIF + II3 = II2 + II2 = II + ELSE IF ( DIF .LE. DIF3 ) THEN + DIF3 = DIF + II3 = II + ENDIF + 10 CONTINUE + A1 = A(II1) + A2 = A(II2) + A3 = A(II3) + RETURN + END |