1 |
|
|
function iso_verif_noNaN_nostop(x,err_msg) |
2 |
|
|
implicit none |
3 |
|
|
! si x est NaN, on affiche message |
4 |
|
|
! d'erreur et return 1 si erreur |
5 |
|
|
|
6 |
|
|
! input: |
7 |
|
|
real x |
8 |
|
|
character*(*) err_msg ! message d''erreur à afficher |
9 |
|
|
|
10 |
|
|
! output |
11 |
|
|
real borne |
12 |
|
|
parameter (borne=1e19) |
13 |
|
|
integer iso_verif_noNaN_nostop |
14 |
|
|
|
15 |
|
|
if ((x.gt.-borne).and.(x.lt.borne)) then |
16 |
|
|
iso_verif_noNAN_nostop=0 |
17 |
|
|
else |
18 |
|
|
write(*,*) 'erreur detectee par iso_verif_nonNaN:' |
19 |
|
|
write(*,*) err_msg |
20 |
|
|
write(*,*) 'x=',x |
21 |
|
|
iso_verif_noNaN_nostop=1 |
22 |
|
|
endif |
23 |
|
|
|
24 |
|
|
return |
25 |
|
|
end |
26 |
|
|
|
27 |
|
|
function iso_verif_egalite_nostop |
28 |
|
|
: (a,b,err_msg) |
29 |
|
|
implicit none |
30 |
|
|
! compare a et b. Si pas egal, on affiche message |
31 |
|
|
! d'erreur et stoppe |
32 |
|
|
! pour egalite, on verifie erreur absolue et arreur relative |
33 |
|
|
|
34 |
|
|
! input: |
35 |
|
|
real a, b |
36 |
|
|
character*(*) err_msg ! message d''erreur à afficher |
37 |
|
|
|
38 |
|
|
! locals |
39 |
|
|
real errmax ! erreur maximale en absolu. |
40 |
|
|
real errmaxrel ! erreur maximale en relatif autorisée |
41 |
|
|
parameter (errmax=1e-8) |
42 |
|
|
parameter (errmaxrel=1e-3) |
43 |
|
|
|
44 |
|
|
! output |
45 |
|
|
integer iso_verif_egalite_nostop |
46 |
|
|
|
47 |
|
|
iso_verif_egalite_nostop=0 |
48 |
|
|
|
49 |
|
|
if (abs(a-b).gt.errmax) then |
50 |
|
|
if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) |
51 |
|
|
: .gt.errmaxrel) then |
52 |
|
|
write(*,*) 'erreur detectee par iso_verif_egalite:' |
53 |
|
|
write(*,*) err_msg |
54 |
|
|
write(*,*) 'a=',a |
55 |
|
|
write(*,*) 'b=',b |
56 |
|
|
iso_verif_egalite_nostop=1 |
57 |
|
|
endif |
58 |
|
|
endif |
59 |
|
|
|
60 |
|
|
return |
61 |
|
|
end |
62 |
|
|
|
63 |
|
|
|
64 |
|
|
function iso_verif_aberrant_nostop |
65 |
|
|
: (x,iso,q,err_msg) |
66 |
|
|
USE infotrac, ONLY: isoName, getKey |
67 |
|
|
implicit none |
68 |
|
|
|
69 |
|
|
! input: |
70 |
|
|
real x,q |
71 |
|
|
integer iso ! 2=HDO, 1=O18 |
72 |
|
|
character*(*) err_msg ! message d''erreur à afficher |
73 |
|
|
|
74 |
|
|
! locals |
75 |
|
|
real qmin,deltaD |
76 |
|
|
real deltaDmax,deltaDmin,tnat |
77 |
|
|
parameter (qmin=1e-11) |
78 |
|
|
parameter (deltaDmax=200.0,deltaDmin=-999.9) |
79 |
|
|
|
80 |
|
|
! output |
81 |
|
|
integer iso_verif_aberrant_nostop |
82 |
|
|
|
83 |
|
|
iso_verif_aberrant_nostop=0 |
84 |
|
|
|
85 |
|
|
! verifier que HDO est raisonable |
86 |
|
|
if (q.gt.qmin) then |
87 |
|
|
IF(getKey('tnat', tnat, isoName(iso))) THEN |
88 |
|
|
err_msg = 'Missing isotopic parameter "tnat"' |
89 |
|
|
iso_verif_aberrant_nostop=1 |
90 |
|
|
RETURN |
91 |
|
|
END IF |
92 |
|
|
deltaD=(x/q/tnat-1)*1000 |
93 |
|
|
if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
94 |
|
|
write(*,*) 'erreur detectee par iso_verif_aberrant:' |
95 |
|
|
write(*,*) err_msg |
96 |
|
|
write(*,*) 'q=',q |
97 |
|
|
write(*,*) 'deltaD=',deltaD |
98 |
|
|
write(*,*) 'iso=',iso |
99 |
|
|
iso_verif_aberrant_nostop=1 |
100 |
|
|
endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
101 |
|
|
endif !if (q(i,k,iq).gt.qmin) then |
102 |
|
|
|
103 |
|
|
|
104 |
|
|
return |
105 |
|
|
end |
106 |
|
|
|