function iso_verif_noNaN_nostop(x,err_msg) implicit none ! si x est NaN, on affiche message ! d'erreur et return 1 si erreur ! input: real x character*(*) err_msg ! message d''erreur à afficher ! output real borne parameter (borne=1e19) integer iso_verif_noNaN_nostop if ((x.gt.-borne).and.(x.lt.borne)) then iso_verif_noNAN_nostop=0 else write(*,*) 'erreur detectee par iso_verif_nonNaN:' write(*,*) err_msg write(*,*) 'x=',x iso_verif_noNaN_nostop=1 endif return end function iso_verif_egalite_nostop : (a,b,err_msg) implicit none ! compare a et b. Si pas egal, on affiche message ! d'erreur et stoppe ! pour egalite, on verifie erreur absolue et arreur relative ! input: real a, b character*(*) err_msg ! message d''erreur à afficher ! locals real errmax ! erreur maximale en absolu. real errmaxrel ! erreur maximale en relatif autorisée parameter (errmax=1e-8) parameter (errmaxrel=1e-3) ! output integer iso_verif_egalite_nostop iso_verif_egalite_nostop=0 if (abs(a-b).gt.errmax) then if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) : .gt.errmaxrel) then write(*,*) 'erreur detectee par iso_verif_egalite:' write(*,*) err_msg write(*,*) 'a=',a write(*,*) 'b=',b iso_verif_egalite_nostop=1 endif endif return end function iso_verif_aberrant_nostop : (x,iso,q,err_msg) #ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin #else USE ioipsl_getincom, ONLY: getin #endif USE infotrac, ONLY: isoName, getKey implicit none ! input: real x,q integer iso ! 2=HDO, 1=O18 character*(*) err_msg ! message d''erreur à afficher ! locals real qmin,deltaD real deltaDmax,deltaDmin,tnat parameter (qmin=1e-11) parameter (deltaDmax=200.0,deltaDmin=-999.9) LOGICAL, SAVE :: ltnat1 LOGICAL, SAVE :: lFirst=.TRUE. ! output integer iso_verif_aberrant_nostop IF(lFirst) THEN ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) lFirst = .FALSE. END IF iso_verif_aberrant_nostop=0 ! verifier que HDO est raisonable if (q.gt.qmin) then IF(ltnat1) THEN tnat = 1.0 ELSE IF(getKey('tnat', tnat, isoName(iso))) THEN err_msg = 'Missing isotopic parameter "tnat"' iso_verif_aberrant_nostop=1 RETURN END IF deltaD=(x/q/tnat-1)*1000 if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then write(*,*) 'erreur detectee par iso_verif_aberrant:' write(*,*) err_msg write(*,*) 'q=',q write(*,*) 'deltaD=',deltaD write(*,*) 'iso=',iso iso_verif_aberrant_nostop=1 endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then endif !if (q(i,k,iq).gt.qmin) then return end