| Line |
Branch |
Exec |
Source |
| 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 |
| 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 |
| 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 |
|
✗ |
deltaD=(x/q/tnat(iso)-1)*1000 |
| 88 |
|
✗ |
if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 89 |
|
✗ |
write(*,*) 'erreur detectee par iso_verif_aberrant:' |
| 90 |
|
✗ |
write(*,*) err_msg |
| 91 |
|
✗ |
write(*,*) 'q=',q |
| 92 |
|
✗ |
write(*,*) 'deltaD=',deltaD |
| 93 |
|
✗ |
write(*,*) 'iso=',iso |
| 94 |
|
|
iso_verif_aberrant_nostop=1 |
| 95 |
|
|
endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 96 |
|
|
endif !if (q(i,k,iq).gt.qmin) then |
| 97 |
|
|
|
| 98 |
|
|
|
| 99 |
|
|
return |
| 100 |
|
|
end |
| 101 |
|
|
|
| 102 |
|
|
|