source: LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotopes_verif_mod.F90 @ 5435

Last change on this file since 5435 was 4368, checked in by lguez, 2 years ago

Sync latest trunk changes to Ocean_skin

  • Property svn:executable set to *
File size: 79.5 KB
Line 
1
2#ifdef ISOVERIF
3! $Id: $
4
5MODULE isotopes_verif_mod
6!use isotopes_mod, ONLY:
7!#ifdef ISOTRAC
8!   USE isotrac_mod, ONLY: nzone
9!#endif
10USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, itZonIso, nzone
11implicit none
12save
13
14! variables de vérifications
15real errmax ! erreur maximale en absolu.
16parameter (errmax=1e-8)
17real errmax_sol ! erreur maximale en absolu.
18parameter (errmax_sol=5e-7)
19      real errmaxrel ! erreur maximale en relatif autorisée
20!      parameter (errmaxrel=1e10)
21      parameter (errmaxrel=1e-3)
22      real borne ! valeur maximale que n'importe quelle variable peut
23                 ! atteindre, en val abs; utile pour vérif que pas NAN
24      parameter (borne=1e19)
25      real, save ::  deltalim ! deltalim est le maximum de deltaD qu'on
26                             ! autorise dans la vapeur, au-dela, en suppose que c'est abérrant.
27                             ! dans le liquide, on autorise deltalim*faccond.
28!$OMP THREADPRIVATE(deltalim)
29!      parameter (deltalim=1e10)
30!      parameter (deltalim=300.0)
31       ! maintenant défini dans iso.def
32
33       real, save :: deltalimtrac ! max de deltaD dans les traceurs, défini dans iso.def
34!$OMP THREADPRIVATE(deltalimtrac)
35
36      real, save ::  deltalim_snow ! deltalim est le maximum de deltaD qu'on
37                             ! autorise dans la neige, au-dela, en suppose que c'est abérrant.
38!$OMP THREADPRIVATE(deltalim_snow)
39!      parameter (deltalim_snow=500.0) ! initalisé dans iso_init
40
41        real, save ::  deltaDmin
42!$OMP THREADPRIVATE(deltaDmin)
43!       parameter (deltaDmin=-900.0)
44    ! maintentant, défini dans iso.def
45
46      real, save ::  o17excess_bas,o17excess_haut ! bornes inf et sup de l'O17-excess
47!      parameter(o17excess_bas=-200.0,o17excess_haut=120)
48!$OMP THREADPRIVATE(o17excess_bas,o17excess_haut)
49      integer nlevmaxO17
50!$OMP THREADPRIVATE(nlevmaxO17)
51
52      logical, save ::  O17_verif
53!$OMP THREADPRIVATE(O17_verif)
54!      parameter (O17_verif=.true.)
55
56        real, save ::  dexcess_min,dexcess_max
57!$OMP THREADPRIVATE(dexcess_min,dexcess_max)
58
59      real faccond  ! dans le liquide, on autorise R(deltalim)*faccond.
60      parameter (faccond=1.1)
61     
62!      logical bidouille_anti_divergence ! si true, alors on fait un
63!                                        ! rappel régulier des xt4 vers les q pour
64!                                        !éviter accumulation d'érreurs et  divergences
65!      parameter (bidouille_anti_divergence=.true.)
66!      parameter (bidouille_anti_divergence=.false.)
67    ! bidouille_anti_divergence a été déplacé dans wateriso2.h et est lue à l'execution
68
69       
70        real deltaDfaible ! deltaD en dessous duquel la vapeur est tellement faible
71        !que on peut accepter que la remise à l'équilibre du sol avec
72        ! cette vapeur donne des deltaDevap aberrants.
73        parameter (deltaDfaible=-300)
74        real deltaDfaible_lax ! deltaD en dessous duquel la vapeur est tellement faible
75        !que on peut accepter que la remise à l'équilibre du sol avec
76        ! cette vapeur donne des deltaDevap aberrants.
77        parameter (deltaDfaible_lax=-180)
78
79        real faible_evap ! faible évaporation: on est plus laxiste
80        !pour les deltaD aberrant dans le cas de l'évap venant d'orchidee
81        parameter (faible_evap=3.0)
82
83        real Tmin_verif
84        parameter (Tmin_verif=5.0) ! en K
85        real Tmax_verif
86        parameter (Tmax_verif=1000.0) ! en K
87
88
89! subroutines de vérifications génériques, à ne pas modifier
90
91 
92CONTAINS
93
94        SUBROUTINE iso_verif_init()
95        use ioipsl_getin_p_mod, ONLY : getin_p
96        use isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
97        implicit none
98
99        write(*,*) 'iso_verif_init 99: entree'
100        deltalim=300.0
101        deltalim_snow=500.0
102        deltaDmin=-900.0
103        deltalimtrac=2000.0
104        O17_verif=.false.
105        o17excess_bas=-200.0
106        o17excess_haut=120.0
107        dexcess_min=-100.0
108        dexcess_max=1000.0
109
110call getin_p('deltalim',deltalim)
111deltalim_snow=deltalim+200.0
112call getin_p('deltaDmin',deltaDmin)
113call getin_p('deltalimtrac',deltalimtrac)
114
115write(*,*) 'iso_O17,iso_O18,iso_HDO=',iso_O17,iso_O18,iso_HDO
116if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
117  call getin_p('O17_verif',O17_verif) 
118  call getin_p('o17excess_bas',o17excess_bas) 
119  call getin_p('o17excess_haut',o17excess_haut) 
120  call getin_p('nlevmaxO17',nlevmaxO17) 
121endif
122if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
123  call getin_p('dexcess_min',dexcess_min) 
124  call getin_p('dexcess_max',dexcess_max) 
125endif
126
127write(*,*) 'deltalim=',deltalim
128write(*,*) 'deltaDmin=',deltaDmin     
129write(*,*) 'deltalimtrac=',deltalimtrac 
130write(*,*) 'O17_verif=',O17_verif
131write(*,*) 'o17excess_bas=',o17excess_bas
132write(*,*) 'o17excess_haut=',o17excess_haut 
133write(*,*) 'dexcess_min=',dexcess_min
134write(*,*) 'dexcess_max=',dexcess_max
135
136        end SUBROUTINE iso_verif_init
137
138      subroutine iso_verif_egalite(a,b,err_msg)
139        implicit none
140        ! compare a et b. Si pas egal à errmax près, on affiche message
141        ! d'erreur et stoppe
142
143        ! input:
144        real a, b
145        character*(*) err_msg ! message d''erreur à afficher
146
147        ! local
148        !integer iso_verif_egalite_choix_nostop
149
150
151        if (iso_verif_egalite_choix_nostop(a,b,err_msg, &
152     &           errmax,errmaxrel).eq.1) then
153                stop
154        endif
155       
156#ifdef ISOVERIF
157#else
158        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
159        stop
160#endif           
161
162        return
163        end subroutine iso_verif_egalite
164
165        !*****************
166
167        function iso_verif_egalite_nostop(a,b,err_msg)
168        implicit none
169        ! compare a et b. Si pas egal à errmax près, on affiche message
170        ! d'erreur et stoppe
171
172        ! input:
173        real a, b
174        character*(*) err_msg ! message d''erreur à afficher
175        !ouptut
176        integer iso_verif_egalite_nostop
177        ! local
178        !integer iso_verif_egalite_choix_nostop
179
180
181        iso_verif_egalite_nostop=iso_verif_egalite_choix_nostop &
182     &          (a,b,err_msg,errmax,errmaxrel)
183
184#ifdef ISOVERIF
185#else
186        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
187        stop
188#endif                 
189
190        return
191        end function iso_verif_egalite_nostop
192
193
194
195        !************************************
196
197        subroutine iso_verif_aberrant(R,err_msg)
198        use isotopes_mod, ONLY: ridicule, iso_HDO
199        implicit none
200        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
201        ! d'erreur et stoppe
202
203        ! input:
204        real R
205        character*(*) err_msg ! message d''erreur à afficher
206        !real deltaD
207        !integer iso_verif_aberrant_choix_nostop
208
209
210        if (iso_verif_aberrant_choix_nostop(R,1.0,ridicule, &
211     &           deltalim,err_msg).eq.1) then
212             stop
213        endif
214
215#ifdef ISOVERIF
216        if (.not.(iso_HDO.gt.0)) then   
217         write(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
218          stop
219        endif
220#else       
221        write(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
222        stop
223#endif                   
224               
225        end subroutine iso_verif_aberrant
226
227        subroutine iso_verif_aberrant_encadre(R,err_msg)
228        use isotopes_mod, ONLY: ridicule, iso_HDO
229        implicit none
230        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
231        ! d'erreur et stoppe
232
233        ! input:
234        real R
235        character*(*) err_msg ! message d''erreur à afficher
236        !real deltaD
237
238        !integer iso_verif_aberrant_enc_choix_nostop
239
240
241        if (iso_verif_aberrant_enc_choix_nostop(R,1.0,ridicule, &
242     &           deltalim,err_msg).eq.1) then
243             write(*,*) 'deltaD=',deltaD(R)
244             call abort_physic('isotopes_verif_mod > iso_verif_aberrant_encadre',err_msg,1)
245             !stop             
246        endif
247
248#ifdef ISOVERIF
249        if (.not.(iso_HDO.gt.0)) then   
250         write(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
251          stop
252        endif
253#else       
254        write(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
255        stop
256#endif                   
257       
258        end subroutine iso_verif_aberrant_encadre
259
260        !************************************
261
262        subroutine iso_verif_aberrant_choix(xt,q,qmin,deltaDmax,err_msg)
263        use isotopes_mod, ONLY: iso_HDO
264        implicit none
265        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
266        ! d'erreur et stoppe
267
268        ! input:
269        real xt,q,qmin,deltaDmax
270        character*(*) err_msg ! message d''erreur à afficher
271        !real deltaD
272
273        ! locals
274        !integer iso_verif_aberrant_choix_nostop
275
276
277        if (iso_verif_aberrant_choix_nostop(xt,q,qmin, &
278     &           deltaDmax,err_msg).eq.1) then
279             stop
280        endif
281
282#ifdef ISOVERIF
283        if (.not.(iso_HDO.gt.0)) then   
284         write(*,*) 'iso122: err_msg=',err_msg,': pourquoi verif?'
285          stop
286        endif
287#else
288        write(*,*) 'iso126: err_msg=',err_msg,': pourquoi verif?'
289        stop
290#endif                   
291       
292        end subroutine iso_verif_aberrant_choix
293
294        !************************************
295
296        function iso_verif_aberrant_nostop(R,err_msg)
297        use isotopes_mod, ONLY: ridicule,iso_HDO
298        implicit none
299        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
300        ! d'erreur et stoppe
301
302        ! input:
303        real R
304        character*(*) err_msg ! message d''erreur à afficher
305        integer iso_verif_aberrant_nostop ! output: 1 si erreur, 0 sinon
306        !real deltaD
307
308        ! locals
309        !integer iso_verif_aberrant_choix_nostop
310
311        iso_verif_aberrant_nostop=iso_verif_aberrant_choix_nostop &
312     &           (R,1.0,ridicule,deltalim,err_msg)
313
314#ifdef ISOVERIF
315        if (.not.(iso_HDO.gt.0)) then   
316         write(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
317          stop
318        endif
319#else
320        write(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
321        stop
322#endif           
323       
324        return
325        end function iso_verif_aberrant_nostop
326
327        function iso_verif_aberrant_enc_nostop(R,err_msg)
328        use isotopes_mod, ONLY: ridicule,iso_HDO
329        implicit none
330        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
331        ! d'erreur et stoppe
332
333        ! input:
334        real R
335        character*(*) err_msg ! message d''erreur à afficher
336        integer iso_verif_aberrant_enc_nostop ! output: 1 si erreur, 0 sinon
337        !real deltaD
338
339        ! locals
340        !integer iso_verif_aberrant_enc_choix_nostop
341
342        iso_verif_aberrant_enc_nostop= &
343     &           iso_verif_aberrant_enc_choix_nostop &
344     &           (R,1.0,ridicule,deltalim,err_msg)
345
346#ifdef ISOVERIF
347        if (.not.(iso_HDO.gt.0)) then   
348         write(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
349          stop
350        endif
351#else
352        write(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
353        stop
354#endif                   
355        return
356        end function iso_verif_aberrant_enc_nostop
357
358        !************************************
359
360        function iso_verif_aberrant_choix_nostop(xt,q,   &
361     &            qmin,deltaDmax,err_msg)
362
363        use isotopes_mod, ONLY: iso_HDO
364        implicit none
365        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
366        ! d'erreur et stoppe
367
368        ! input:
369        real xt,q,qmin,deltaDmax
370        character*(*) err_msg ! message d''erreur à afficher
371        ! output
372        integer iso_verif_aberrant_choix_nostop
373        ! locals
374        !real deltaD
375        !integer iso_verif_noNaN_nostop       
376
377
378        iso_verif_aberrant_choix_nostop=0
379
380#ifdef ISOVERIF       
381        if (iso_verif_noNaN_nostop(q,err_msg).eq.1) then
382            write(*,*) 'q=',q
383            iso_verif_aberrant_choix_nostop=1
384        endif     
385        if (iso_verif_noNaN_nostop(xt,err_msg).eq.1) then
386            write(*,*) 'xt=',xt
387            iso_verif_aberrant_choix_nostop=1
388        endif
389#endif
390
391        if (q.gt.qmin) then
392        if ((deltaD(xt/q).gt.deltaDmax).or. &
393     &          (deltaD(xt/q).lt.-borne).or. &
394     &          (xt.lt.-borne).or. &
395     &          (xt.gt.borne)) then                 
396            write(*,*) 'erreur detectee par '// &
397     &             'iso_verif_aberrant_choix_nostop:'
398            write(*,*) err_msg
399            write(*,*) 'q,deltaD=',q,deltaD(xt/q)
400            write(*,*) 'deltaDmax=',deltaDmax
401            iso_verif_aberrant_choix_nostop=1
402            if (abs(xt-q)/q.lt.errmax) then
403                write(*,*) 'attention, n''a-t-on pas confondu'// &
404     &           ' iso_HDO et iso_eau dans l''appel à la verif?'
405            endif
406        endif
407        endif
408
409#ifdef ISOVERIF
410        if (.not.(iso_HDO.gt.0)) then   
411         write(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
412          stop
413        endif
414#else
415        write(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
416        stop
417#endif                   
418       
419        return
420        end function iso_verif_aberrant_choix_nostop
421
422        function iso_verif_aberrant_enc_choix_nostop(xt,q,   &
423     &            qmin,deltaDmax,err_msg)
424        use isotopes_mod, ONLY: iso_HDO
425        implicit none
426        ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
427        ! d'erreur et stoppe
428
429        ! input:
430        real xt,q,qmin,deltaDmax
431        character*(*) err_msg ! message d''erreur à afficher
432        ! output
433        integer iso_verif_aberrant_enc_choix_nostop
434        ! locals
435        !real deltaD
436
437        iso_verif_aberrant_enc_choix_nostop=0
438        if (q.gt.qmin) then
439        if ((deltaD(xt/q).gt.deltaDmax).or. &
440     &          (deltaD(xt/q).lt.deltaDmin)) then                 
441            write(*,*) 'erreur detectee par '// &
442     &             'iso_verif_aberrant_choix_nostop:'
443            write(*,*) err_msg
444            write(*,*) 'q,deltaD=',q,deltaD(xt/q)
445            iso_verif_aberrant_enc_choix_nostop=1
446            if (abs(xt-q)/q.lt.errmax) then
447                write(*,*) 'attention, n''a-t-on pas confondu'// &
448     &           ' iso_HDO et iso_eau dans l''appel à la verif?'
449            endif
450        endif
451        endif
452
453#ifdef ISOVERIF
454        if (.not.(iso_HDO.gt.0)) then   
455         write(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
456          stop
457        endif
458#else
459        write(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
460        stop
461#endif                   
462       
463        return
464        end function iso_verif_aberrant_enc_choix_nostop
465
466        !*******************
467
468        subroutine iso_verif_aberrant_o17(R17,R18,err_msg)
469        implicit none
470        ! si l'O17-excess est aberrant, on affiche un message
471        ! d'erreur et stoppe
472
473        ! input:
474        real R17,R18
475        character*(*) err_msg ! message d''erreur à afficher
476        !real o17excess
477
478        ! locals
479        !integer iso_verif_aberrant_o17_nostop
480
481!        write(*,*) 'O17_verif=',O17_verif
482        if (O17_verif) then
483            if (iso_verif_aberrant_o17_nostop(R17,R18,err_msg) &
484     &           .eq.1) then
485                stop
486            endif
487        endif !if (O17_verif) then
488
489#ifdef ISOVERIF
490#else
491        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
492        stop
493#endif                   
494       
495        return
496        end subroutine iso_verif_aberrant_o17
497
498        !*******************
499
500        function iso_verif_aberrant_o17_nostop(R17,R18,err_msg)
501        USE isotopes_mod, ONLY: tnat,iso_O17,iso_O18
502        implicit none
503        ! si l'O17-excess est aberrant, on affiche un message
504        ! d'erreur et renvoit 1
505
506        ! input:
507        real R17,R18
508        character*(*) err_msg ! message d''erreur à afficher
509        !local
510        !real o17excess
511        ! output
512        integer iso_verif_aberrant_o17_nostop
513
514        if (O17_verif) then
515
516        iso_verif_aberrant_o17_nostop=0
517        if ((o17excess(R17,R18).gt.o17excess_haut).or. &
518     &            (o17excess(R17,R18).lt.o17excess_bas)) then 
519            write(*,*) 'erreur detectee par iso_verif_aberrant_O17:'
520            write(*,*) err_msg
521            write(*,*) 'o17excess=',o17excess(R17,R18)
522            write(*,*) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
523            write(*,*) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
524            ! attention, vérifier que la ligne suivante est bien activée
525            iso_verif_aberrant_o17_nostop=1
526        endif
527
528        endif  !if (O17_verif) then
529
530#ifdef ISOVERIF
531#else
532        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
533        stop
534#endif                   
535       
536        return
537        end function iso_verif_aberrant_o17_nostop
538
539
540        !************************************
541
542        subroutine iso_verif_noNaN(x,err_msg)
543        implicit none
544        ! si x est NaN, on affiche message
545        ! d'erreur et stoppe
546
547        ! input:
548        real x
549        character*(*) err_msg ! message d''erreur à afficher
550
551        ! locals
552        !integer iso_verif_noNAN_nostop
553
554        if (iso_verif_noNAN_nostop(x,err_msg).eq.1) then
555            stop
556        endif
557#ifdef ISOVERIF
558#else
559        write(*,*) 'err_msg iso443=',err_msg,': pourquoi verif?'
560        stop
561#endif           
562       
563        end subroutine iso_verif_noNaN
564
565                !************************************
566
567        function iso_verif_noNaN_nostop(x,err_msg)
568        implicit none
569        ! si x est NaN, on affiche message
570        ! d'erreur et return 1 si erreur
571
572        ! input:
573        real x
574        character*(*) err_msg ! message d''erreur à afficher
575
576        ! output
577        integer iso_verif_noNAN_nostop
578
579        if ((x.gt.-borne).and.(x.lt.borne)) then
580                iso_verif_noNAN_nostop=0
581        else
582            write(*,*) 'erreur detectee par iso_verif_nonNAN:'
583            write(*,*) err_msg
584            write(*,*) 'x=',x
585            iso_verif_noNAN_nostop=1
586        endif     
587
588#ifdef ISOVERIF
589#else
590        write(*,*) 'err_msg iso 482=',err_msg,': pourquoi verif?'
591        stop
592#endif           
593
594        return
595        end function iso_verif_noNaN_nostop
596
597        subroutine iso_verif_noNaN_vect2D(x,err_msg,ni,n,m)
598        implicit none
599        ! si x est NaN, on affiche message
600        ! d'erreur et return 1 si erreur
601
602        ! input:
603          integer n,m,ni
604        real x(ni,n,m)
605        character*(*) err_msg ! message d''erreur à afficher
606
607        ! output
608
609        ! locals       
610        integer i,j,ixt
611
612      do i=1,n
613       do j=1,m
614        do ixt=1,ni
615         if ((x(ixt,i,j).gt.-borne).and. &
616     &            (x(ixt,i,j).lt.borne)) then
617         else !if ((x(ixt,i,j).gt.-borne).and.
618            write(*,*) 'erreur detectee par iso_verif_nonNAN:'
619            write(*,*) err_msg
620            write(*,*) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
621            stop
622         endif  !if ((x(ixt,i,j).gt.-borne).and.
623        enddo !do ixt=1,ni
624       enddo !do j=1,m
625      enddo !do i=1,n     
626
627#ifdef ISOVERIF
628#else
629        write(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
630        stop
631#endif           
632
633        end subroutine iso_verif_noNaN_vect2D
634
635
636        subroutine iso_verif_noNaN_vect1D(x,err_msg,ni,n)
637        implicit none
638        ! si x est NaN, on affiche message
639        ! d'erreur et return 1 si erreur
640
641        ! input:
642          integer n,ni
643        real x(ni,n)
644        character*(*) err_msg ! message d''erreur à afficher
645
646        ! output
647
648        ! locals       
649        integer i,ixt
650
651      do i=1,n
652        do ixt=1,ni
653         if ((x(ixt,i).gt.-borne).and. &
654     &            (x(ixt,i).lt.borne)) then
655         else !if ((x(ixt,i,j).gt.-borne).and.
656            write(*,*) 'erreur detectee par iso_verif_nonNAN:'
657            write(*,*) err_msg
658            write(*,*) 'x,ixt,i=',x(ixt,i),ixt,i
659            stop
660         endif  !if ((x(ixt,i,j).gt.-borne).and.
661        enddo !do ixt=1,ni
662      enddo !do i=1,n     
663
664#ifdef ISOVERIF
665#else
666        write(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
667        stop
668#endif           
669
670        end subroutine iso_verif_noNaN_vect1D
671
672
673
674        !************************
675        subroutine iso_verif_egalite_choix(a,b,err_msg,erabs,errel)
676        implicit none
677        ! compare a et b. Si pas egal, on affiche message
678        ! d'erreur et stoppe
679        ! pour egalite, on verifie erreur absolue et arreur relative
680
681        ! input:
682        real a, b
683        real erabs,errel !erreur absolue et relative
684        character*(*) err_msg ! message d''erreur à afficher
685
686        ! locals
687        !integer iso_verif_egalite_choix_nostop
688
689        if (iso_verif_egalite_choix_nostop( &
690     &            a,b,err_msg,erabs,errel).eq.1) then
691           stop
692        endif
693
694#ifdef ISOVERIF
695#else
696        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
697        stop
698#endif           
699
700        end subroutine iso_verif_egalite_choix
701
702!************************
703        function iso_verif_egalite_choix_nostop &
704     &           (a,b,err_msg,erabs,errel)
705        implicit none
706        ! compare a et b. Si pas egal, on affiche message
707        ! d'erreur et stoppe
708        ! pour egalite, on verifie erreur absolue et arreur relative
709
710        ! input:
711        real a, b
712        real erabs,errel !erreur absolue et relative
713        character*(*) err_msg ! message d''erreur à afficher
714
715        ! output
716        integer iso_verif_egalite_choix_nostop
717        ! locals
718        !integer iso_verif_noNaN_nostop
719
720        iso_verif_egalite_choix_nostop=0
721
722#ifdef ISOVERIF
723        if (iso_verif_noNaN_nostop(a,err_msg).eq.1) then
724            write(*,*) 'a=',a
725            iso_verif_egalite_choix_nostop=1
726        endif     
727        if (iso_verif_noNaN_nostop(b,err_msg).eq.1) then
728            write(*,*) 'b=',b
729            iso_verif_egalite_choix_nostop=1
730        endif     
731#endif
732
733        if (abs(a-b).gt.erabs) then
734          if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
735     &            .gt.errel) then
736            write(*,*) 'erreur detectee par iso_verif_egalite:'
737            write(*,*) err_msg
738            write(*,*) 'a=',a
739            write(*,*) 'b=',b
740            write(*,*) 'erabs,errel=',erabs,errel
741            iso_verif_egalite_choix_nostop=1
742!            stop
743          endif
744        endif
745
746#ifdef ISOVERIF
747#else
748        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
749        stop
750#endif           
751       
752        return
753        end function iso_verif_egalite_choix_nostop       
754
755
756
757        !******************
758        subroutine iso_verif_positif(x,err_msg)
759        use isotopes_mod, ONLY: ridicule
760        implicit none
761        ! si x<0, on plante.
762        ! si très limite, on le met à 0.
763
764        ! input:
765        real x
766        character*(*) err_msg ! message d''erreur à afficher
767
768        ! locals
769        !integer iso_verif_positif_choix_nostop
770
771        if (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
772     &           .eq.1) then
773           stop
774        endif
775     
776#ifdef ISOVERIF
777#else
778        write(*,*) 'iso_verif 637: err_msg=',err_msg, &
779     &           ': pourquoi verif?'
780        stop
781#endif
782       
783        end subroutine iso_verif_positif
784
785        !******************
786        subroutine iso_verif_positif_vect(x,n,err_msg)
787        use isotopes_mod, ONLY: ridicule
788        implicit none
789        ! si x<0, on plante.
790
791        ! input:
792        integer n
793        real x(n)
794        character*(*) err_msg ! message d''erreur à afficher
795
796        ! locals
797        integer i
798        integer iso_verif_positif_nostop
799        integer ifaux
800
801        iso_verif_positif_nostop=0
802        do i=1,n
803          if (x(i).lt.-ridicule) then
804            iso_verif_positif_nostop=1
805            ifaux=i
806          endif
807        enddo
808        if (iso_verif_positif_nostop.eq.1) then
809          write(*,*) 'erreur detectee par iso_verif_positif_vect:'
810          write(*,*) err_msg
811          write(*,*) 'i,x=',ifaux,x(ifaux)
812          stop
813        endif   
814       
815        end subroutine iso_verif_positif_vect
816
817        subroutine iso_verif_positif_choix_vect(x,n,ridic,err_msg)
818        implicit none
819        ! si x<0, on plante.
820
821        ! input:
822        integer n
823        real x(n)
824        real ridic
825        character*(*) err_msg ! message d''erreur à afficher
826        ! locals
827        integer i
828        integer iso_verif_positif_nostop
829        integer ifaux
830
831        iso_verif_positif_nostop=0
832        do i=1,n
833          if (x(i).lt.-ridic) then
834                iso_verif_positif_nostop=1
835                ifaux=i
836          endif
837        enddo
838        if (iso_verif_positif_nostop.eq.1) then                       
839         write(*,*) 'erreur detectee par iso_verif_positif_choix_vect:'
840         write(*,*) err_msg
841         write(*,*) 'i,x=',ifaux,x(ifaux)
842         stop
843        endif   
844       
845        end subroutine iso_verif_positif_choix_vect
846
847
848!******************
849        subroutine iso_verif_positif_strict(x,err_msg)
850        implicit none
851        ! si x<0, on plante.
852        ! si très limite, on le met à 0.
853
854        ! input:
855        real x
856        character*(*) err_msg ! message d''erreur à afficher
857
858        ! locals
859        !integer iso_verif_positif_strict_nostop
860
861        if (iso_verif_positif_strict_nostop(x,err_msg) &
862     &           .eq.1) then
863           stop
864        endif           
865       
866        end subroutine iso_verif_positif_strict
867
868!******************
869
870        function iso_verif_positif_strict_nostop(x,err_msg)
871        implicit none
872        ! si x<0, on plante.
873        ! si très limite, on le met à 0.
874
875        ! input:
876        real x
877        character*(*) err_msg ! message d''erreur à afficher*
878
879        ! output
880        integer iso_verif_positif_strict_nostop
881
882        if (x.gt.0.0) then
883            iso_verif_positif_strict_nostop=0
884        else     
885            write(*,*) 'erreur detectee par iso_verif_positif_strict:'
886            write(*,*) err_msg
887            write(*,*) 'x=',x 
888            iso_verif_positif_strict_nostop=1   
889!            stop 
890        endif   
891       
892        return
893        end function iso_verif_positif_strict_nostop
894
895!******************
896
897        subroutine iso_verif_positif_choix(x,ridic,err_msg)
898        implicit none
899        ! si x<0, on plante.
900        ! si très limite, on le met à 0.
901
902        ! input:
903        real x
904        real ridic
905        character*(*) err_msg ! message d''erreur à afficher
906
907        ! locals
908        !integer iso_verif_positif_choix_nostop
909
910        if (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
911     &           .eq.1) then
912           stop
913        endif
914     
915#ifdef ISOVERIF
916#else
917        write(*,*) 'iso_verif 801: err_msg=',err_msg, &
918     &           ': pourquoi verif?'
919        stop
920#endif           
921       
922        end subroutine iso_verif_positif_choix       
923
924        !******************
925        function iso_verif_positif_nostop(x,err_msg)
926        use isotopes_mod, ONLY: ridicule
927        implicit none
928        ! si x<0, on plante.
929        ! si très limite, on le met à 0.
930
931        ! input:
932        real x
933        character*(*) err_msg ! message d''erreur à afficher
934
935        ! output
936        integer iso_verif_positif_nostop
937
938        ! locals
939        !integer iso_verif_positif_choix_nostop
940
941        iso_verif_positif_nostop=iso_verif_positif_choix_nostop &
942     &          (x,ridicule,err_msg)
943
944#ifdef ISOVERIF
945#else
946        write(*,*) 'iso_verif 837: err_msg=',err_msg, &
947     &           ': pourquoi verif?'
948        stop
949
950#endif         
951       
952        return
953        end function iso_verif_positif_nostop
954
955        !******************
956        function iso_verif_positif_choix_nostop(x,ridic,err_msg)
957        implicit none
958        ! si x<0, on plante.
959        ! si très limite, on le met à 0.
960
961        ! input:
962        real x
963        real ridic
964        character*(*) err_msg ! message d''erreur à afficher
965
966        ! output
967        integer iso_verif_positif_choix_nostop
968
969        if (x.lt.-ridic) then
970            write(*,*) 'erreur detectee par iso_verif_positif_nostop:'
971            write(*,*) err_msg
972            write(*,*) 'x=',x
973            iso_verif_positif_choix_nostop=1
974        else
975!            x=max(x,0.0)
976            iso_verif_positif_choix_nostop=0
977        endif
978
979#ifdef ISOVERIF
980#else
981        write(*,*) 'iso_verif 877: err_msg=',err_msg, &
982     &           ': pourquoi verif?'
983        stop
984#endif
985       
986        return
987        end function iso_verif_positif_choix_nostop
988
989
990        !**************
991
992       
993        subroutine iso_verif_O18_aberrant(Rd,Ro,err_msg)
994        implicit none
995
996        ! vérifie que:
997        ! 1) deltaD et deltaO18 dans bonne gamme
998        ! 2) dexcess dans bonne gamme
999        ! input:
1000        real Rd,Ro
1001        character*(*) err_msg ! message d''erreur à afficher
1002
1003        ! local
1004        !integer iso_verif_O18_aberrant_nostop
1005
1006        if (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).eq.1) then
1007            stop
1008        endif
1009
1010        end subroutine iso_verif_O18_aberrant
1011       
1012        function iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg)
1013        USE isotopes_mod, ONLY: tnat, iso_HDO, iso_O18
1014        implicit none
1015
1016        ! vérifie que:
1017        ! 1) deltaD et deltaO18 dans bonne gamme
1018        ! 2) dexcess dans bonne gamme
1019
1020        ! input:
1021        real Rd,Ro
1022        character*(*) err_msg ! message d''erreur à afficher
1023
1024        ! outputs
1025        integer iso_verif_O18_aberrant_nostop
1026
1027        !locals
1028        real deltaD,deltao,dexcess
1029
1030        deltaD=(Rd/tnat(iso_hdo)-1)*1000
1031        deltao=(Ro/tnat(iso_O18)-1)*1000
1032        dexcess=deltaD-8*deltao
1033
1034        iso_verif_O18_aberrant_nostop=0
1035        if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
1036     &        (deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
1037     &        ((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
1038     &        .or.(dexcess.gt.dexcess_max)))) then
1039            write(*,*) 'erreur detectee par iso_verif_O18_aberrant:'
1040            write(*,*) err_msg
1041            write(*,*) 'delta180=',deltao
1042            write(*,*) 'deltaD=',deltaD
1043            write(*,*) 'Dexcess=',dexcess
1044!            stop
1045            iso_verif_O18_aberrant_nostop=1
1046          endif
1047
1048#ifdef ISOVERIF
1049#else
1050        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
1051        stop
1052#endif                   
1053
1054        return
1055        end function iso_verif_O18_aberrant_nostop
1056
1057
1058        ! **********
1059        function deltaD(R)
1060        USE isotopes_mod, ONLY: tnat,iso_HDO
1061        implicit none
1062        real R,deltaD
1063
1064       
1065        if (iso_HDO.gt.0) then
1066           deltaD=(R/tnat(iso_HDO)-1)*1000.0
1067        else
1068            write(*,*) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
1069     &           iso_HDO.gt.0
1070        endif
1071        return
1072        end function deltaD
1073
1074        ! **********
1075        function deltaO(R)
1076        USE isotopes_mod, ONLY: tnat,iso_O18
1077        implicit none
1078        real R,deltaO
1079       
1080        if (iso_O18.gt.0) then
1081           deltaO=(R/tnat(iso_O18)-1)*1000.0
1082        else
1083            write(*,*) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
1084     &           iso_O18.gt.0
1085        endif
1086        return
1087        end function deltaO
1088
1089        ! **********
1090        function dexcess(RD,RO)
1091        USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
1092        implicit none
1093        real RD,RO,deltaD,deltaO,dexcess
1094       
1095        if ((iso_O18.gt.0).and.(iso_HDO.gt.0)) then
1096           deltaD=(RD/tnat(iso_HDO)-1)*1000.0
1097           deltaO=(RO/tnat(iso_O18)-1)*1000.0
1098           dexcess=deltaD-8*deltaO
1099        else
1100            write(*,*) 'iso_verif_egalite 1109: iso_O18,iso_HDO=',iso_O18,iso_HDO
1101        endif
1102        return
1103        end function dexcess
1104
1105
1106        ! **********
1107        function delta_all(R,ixt)
1108        USE isotopes_mod, ONLY: tnat
1109        implicit none
1110        real R,delta_all
1111        integer ixt
1112       
1113        delta_all=(R/tnat(ixt)-1)*1000.0
1114        return
1115        end function delta_all
1116
1117        ! **********
1118        function delta_to_R(delta,ixt)
1119        USE isotopes_mod, ONLY: tnat
1120        implicit none
1121        real delta,delta_to_R
1122        integer ixt
1123       
1124        delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
1125        return
1126        end function delta_to_R
1127
1128         ! **********
1129        function o17excess(R17,R18)
1130        USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
1131        implicit none
1132        real R17,R18,o17excess
1133       
1134        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
1135           
1136           o17excess=1e6*(log(R17/tnat(iso_o17)) &
1137     &           -0.528*log(R18/tnat(iso_O18)))
1138!           write(*,*) 'o17excess=',o17excess
1139        else
1140            write(*,*) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
1141     &           iso_O17.gt.0,iso_O18.gt.0
1142        endif
1143        return
1144        end function o17excess
1145
1146        !       ****************
1147
1148          subroutine iso_verif_egalite_vect2D( &
1149     &           xt,q,err_msg,ni,n,m)
1150       
1151        USE isotopes_mod, ONLY: iso_eau
1152          implicit none
1153
1154          ! inputs
1155          integer n,m,ni
1156          real q(n,m)
1157          real xt(ni,n,m)
1158          character*(*) err_msg
1159
1160        ! locals
1161        integer iso_verif_egalite_nostop_loc
1162        integer i,j,ixt
1163        integer ifaux,jfaux
1164
1165        !write(*,*) 'iso_verif_egalite_vect2D 1099 tmp: q(2,1),xt(iso_eau,2,1)=',q(2,1),xt(iso_eau,2,1)
1166        !write(*,*) 'ni,n,m=',ni,n,m,errmax,errmaxrel
1167        if (iso_eau.gt.0) then
1168        iso_verif_egalite_nostop_loc=0
1169        do i=1,n
1170         do j=1,m
1171          if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1172           if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1173     &           max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1174     &           .gt.errmaxrel) then
1175              iso_verif_egalite_nostop_loc=1
1176              ifaux=i
1177              jfaux=j
1178           endif
1179          endif
1180         enddo !do j=1,m
1181        enddo !do i=1,n
1182
1183        if (iso_verif_egalite_nostop_loc.eq.1) then
1184          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
1185          write(*,*) err_msg
1186          write(*,*) 'i,j=',ifaux,jfaux
1187          write(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1188          stop
1189        endif
1190        endif
1191       
1192#ifdef ISOVERIF
1193        call iso_verif_noNaN_vect2D(xt,err_msg,ni,n,m)
1194#endif         
1195
1196        return
1197        end subroutine iso_verif_egalite_vect2D
1198
1199        subroutine iso_verif_egalite_vect1D( &
1200     &           xt,q,err_msg,ni,n)
1201
1202        USE isotopes_mod, ONLY: iso_eau
1203        implicit none
1204
1205        ! inputs
1206        integer n,ni
1207        real q(n)
1208        real xt(ni,n)
1209        character*(*) err_msg
1210
1211        ! locals
1212        integer iso_verif_egalite_nostop_loc
1213        integer i
1214        integer ifaux
1215
1216        if (iso_eau.gt.0) then
1217        iso_verif_egalite_nostop_loc=0
1218        do i=1,n
1219          if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1220           if (abs((q(i)-xt(iso_eau,i))/ &
1221     &           max(max(abs(q(i)),abs(xt(iso_eau,i))),1e-18)) &
1222     &           .gt.errmaxrel) then
1223              iso_verif_egalite_nostop_loc=1
1224              ifaux=i
1225           endif !if (abs((q(i)-xt(iso_eau,i))/
1226          endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1227        enddo !do i=1,n
1228
1229        if (iso_verif_egalite_nostop_loc.eq.1) then
1230          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
1231          write(*,*) err_msg
1232          write(*,*) 'i=',ifaux
1233          write(*,*) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
1234          stop
1235        endif  !if (iso_verif_egalite_nostop.eq.1) then
1236        endif !if (iso_eau.gt.0) then
1237
1238        end subroutine iso_verif_egalite_vect1D       
1239
1240        subroutine iso_verif_egalite_std_vect( &
1241     &           a,b,err_msg,n,m,errmax,errmaxrel)
1242
1243          implicit none
1244
1245          ! inputs
1246          integer n,m,ni
1247          real a(n,m)
1248          real b(n,m)
1249          character*(*) err_msg
1250          real errmax,errmaxrel
1251
1252        ! locals
1253        integer iso_verif_egalite_nostop_loc
1254        integer i,j
1255        integer ifaux,jfaux
1256
1257        iso_verif_egalite_nostop_loc=0
1258        do i=1,n
1259         do j=1,m
1260          if (abs(a(i,j)-b(i,j)).gt.errmax) then
1261           if (abs((a(i,j)-b(i,j))/ &
1262     &           max(max(abs(a(i,j)),abs(b(i,j))),1e-18)) &
1263     &           .gt.errmaxrel) then
1264              iso_verif_egalite_nostop_loc=1
1265              ifaux=i
1266              jfaux=j
1267           endif
1268          endif
1269         enddo !do j=1,m
1270        enddo !do i=1,n
1271
1272        if (iso_verif_egalite_nostop_loc.eq.1) then
1273          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
1274          write(*,*) err_msg
1275          write(*,*) 'i,j=',ifaux,jfaux
1276          write(*,*) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
1277          stop
1278        endif
1279
1280        return
1281        end subroutine iso_verif_egalite_std_vect
1282
1283        subroutine iso_verif_aberrant_vect2D( &
1284     &           xt,q,err_msg,ni,n,m)
1285        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1286          implicit none
1287
1288          ! inputs   
1289          integer n,m,ni
1290          real q(n,m)
1291          real xt(ni,n,m)
1292          character*(*) err_msg
1293
1294        ! locals
1295        integer iso_verif_aberrant_nostop_loc
1296        integer i,j
1297        integer ifaux,jfaux
1298        !real deltaD
1299
1300        if (iso_HDO.gt.0) then
1301        iso_verif_aberrant_nostop_loc=0
1302        do i=1,n
1303         do j=1,m
1304          if (q(i,j).gt.ridicule) then
1305            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1306     &                   .gt.deltalim).or. &
1307     &          ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1308     &                   .lt.-borne)) then   
1309              iso_verif_aberrant_nostop_loc=1
1310              ifaux=i
1311              jfaux=j
1312           endif
1313          endif
1314         enddo !do j=1,m
1315        enddo !do i=1,n
1316
1317        if (iso_verif_aberrant_nostop_loc.eq.1) then
1318          write(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
1319          write(*,*) err_msg
1320          write(*,*) 'i,j=',ifaux,jfaux
1321          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1322     &           /q(ifaux,jfaux))
1323          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1324          stop
1325        endif 
1326        endif !if (iso_HDO.gt.0) then
1327
1328        end subroutine iso_verif_aberrant_vect2D       
1329
1330        subroutine iso_verif_aberrant_enc_vect2D( &
1331     &           xt,q,err_msg,ni,n,m)
1332
1333        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1334          implicit none
1335
1336          ! inputs   
1337          integer n,m,ni
1338          real q(n,m)
1339          real xt(ni,n,m)
1340          character*(*) err_msg
1341
1342        ! locals
1343        integer iso_verif_aberrant_nostop_loc
1344        integer i,j
1345        integer ifaux,jfaux
1346        !real deltaD
1347
1348        if (iso_HDO.gt.0) then
1349        iso_verif_aberrant_nostop_loc=0
1350        do i=1,n
1351         do j=1,m
1352          if (q(i,j).gt.ridicule) then
1353            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1354     &                   .gt.deltalim).or. &
1355     &          ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1356     &                   .lt.deltaDmin).or. &
1357     &           (xt(iso_HDO,i,j).lt.-borne).or. &
1358     &           (xt(iso_HDO,i,j).gt.borne)) then     
1359              iso_verif_aberrant_nostop_loc=1
1360              ifaux=i
1361              jfaux=j
1362           endif
1363          endif
1364         enddo !do j=1,m
1365        enddo !do i=1,n
1366
1367        if (iso_verif_aberrant_nostop_loc.eq.1) then
1368          write(*,*) 'erreur detectee par ', &
1369     &           'iso_verif_aberrant_enc_vect2D:'
1370          write(*,*) err_msg
1371          write(*,*) 'i,j=',ifaux,jfaux
1372          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1373     &           /q(ifaux,jfaux))
1374          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1375          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1376          call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1377        endif 
1378        endif !if (iso_HDO.gt.0) then
1379
1380        end subroutine iso_verif_aberrant_enc_vect2D       
1381
1382       
1383        subroutine iso_verif_aberrant_enc_vect2D_ns( &
1384     &           xt,q,err_msg,ni,n,m)
1385
1386        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1387          implicit none
1388
1389          ! inputs   
1390          integer n,m,ni
1391          real q(n,m)
1392          real xt(ni,n,m)
1393          character*(*) err_msg
1394
1395        ! locals
1396        integer iso_verif_aberrant_nostop_loc
1397        integer i,j
1398        integer ifaux,jfaux
1399        !real deltaD
1400
1401        if (iso_HDO.gt.0) then
1402        iso_verif_aberrant_nostop_loc=0
1403        do i=1,n
1404         do j=1,m
1405          if (q(i,j).gt.ridicule) then
1406            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1407     &                   .gt.deltalim).or. &
1408     &          ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1409     &                   .lt.deltaDmin)) then   
1410              iso_verif_aberrant_nostop_loc=1
1411              ifaux=i
1412              jfaux=j
1413           endif
1414          endif
1415         enddo !do j=1,m
1416        enddo !do i=1,n
1417
1418        if (iso_verif_aberrant_nostop_loc.eq.1) then
1419          write(*,*) 'erreur detectee par ', &
1420     &           'iso_verif_aberrant_vect2D_ns:'
1421          write(*,*) err_msg
1422          write(*,*) 'i,j=',ifaux,jfaux
1423          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1424     &           /q(ifaux,jfaux))
1425          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1426!          stop
1427        endif 
1428        endif !if (iso_HDO.gt.0) then
1429
1430        end subroutine iso_verif_aberrant_enc_vect2D_ns       
1431
1432
1433         subroutine iso_verif_aberrant_vect2Dch( &
1434     &           xt,q,err_msg,ni,n,m,deltaDmax)
1435
1436        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1437          implicit none
1438
1439
1440          ! inputs   
1441          integer n,m,ni
1442          real q(n,m)
1443          real xt(ni,n,m)
1444          character*(*) err_msg
1445          real deltaDmax
1446
1447        ! locals
1448        integer iso_verif_aberrant_nostop_loc
1449        integer i,j
1450        integer ifaux,jfaux
1451        !real deltaD
1452
1453        if (iso_HDO.gt.0) then
1454        iso_verif_aberrant_nostop_loc=0
1455        do i=1,n
1456         do j=1,m
1457          if (q(i,j).gt.ridicule) then
1458            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1459     &                   .gt.deltaDmax).or. &
1460     &          ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1461     &                   .lt.-borne)) then   
1462              iso_verif_aberrant_nostop_loc=1
1463              ifaux=i
1464              jfaux=j
1465           endif
1466          endif
1467         enddo !do j=1,m
1468        enddo !do i=1,n
1469
1470        if (iso_verif_aberrant_nostop_loc.eq.1) then
1471          write(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
1472          write(*,*) err_msg
1473          write(*,*) 'i,j=',ifaux,jfaux
1474          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1475     &           /q(ifaux,jfaux))
1476          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1477          stop
1478        endif 
1479        endif !if (iso_HDO.gt.0) then
1480
1481        end subroutine iso_verif_aberrant_vect2Dch     
1482
1483        subroutine iso_verif_O18_aberrant_enc_vect2D( &
1484     &           xt,q,err_msg,ni,n,m)
1485
1486        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
1487          implicit none
1488
1489          ! inputs   
1490          integer n,m,ni
1491          real q(n,m)
1492          real xt(ni,n,m)
1493          character*(*) err_msg
1494
1495        ! locals
1496        integer iso_verif_aberrant_nostop_loc
1497        integer i,j
1498        integer ifaux,jfaux
1499        real deltaDloc,deltaoloc,dexcessloc
1500
1501        if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
1502        iso_verif_aberrant_nostop_loc=0
1503        do i=1,n
1504         do j=1,m
1505          if (q(i,j).gt.ridicule) then
1506
1507            deltaDloc=(xt(iso_HDO,i,j)/q(i,j)/tnat(iso_hdo)-1)*1000
1508            deltaoloc=(xt(iso_O18,i,j)/q(i,j)/tnat(iso_O18)-1)*1000
1509            dexcessloc=deltaDloc-8*deltaoloc
1510            if ((deltaDloc.lt.deltaDmin).or.(deltaoloc.lt.deltaDmin/2.0).or. &
1511     &        (deltaDloc.gt.deltalim).or.(deltaoloc.gt.deltalim/8.0).or. &
1512     &        ((deltaDloc.gt.-500.0).and.((dexcessloc.lt.dexcess_min) &
1513     &        .or.(dexcessloc.gt.dexcess_max)))) then
1514              iso_verif_aberrant_nostop_loc=1
1515              ifaux=i
1516              jfaux=j
1517              write(*,*) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
1518           endif
1519          endif
1520         enddo !do j=1,m
1521        enddo !do i=1,n
1522
1523        if (iso_verif_aberrant_nostop_loc.eq.1) then
1524          write(*,*) 'erreur detectee par ', &
1525     &           'iso_verif_aberrant_enc_vect2D:'
1526          write(*,*) err_msg
1527          write(*,*) 'i,j=',ifaux,jfaux
1528          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1529          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1530          call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1531        endif 
1532        endif !if (iso_HDO.gt.0) then
1533
1534        end subroutine iso_verif_O18_aberrant_enc_vect2D   
1535
1536
1537        subroutine select_dim23_from4D(n1,n2,n3,n4, &
1538     &          var,vec,i1,i4)
1539        implicit none
1540
1541        ! inputs
1542        integer n1,n2,n3,n4
1543        real var(n1,n2,n3,n4)
1544        integer i1,i4
1545        ! outputs
1546        real vec(n2,n3)
1547        ! locals
1548        integer i2,i3
1549
1550        do i2=1,n2
1551         do i3=1,n3
1552          vec(i2,i3)=var(i1,i2,i3,i4)
1553         enddo
1554        enddo
1555
1556        return
1557        end subroutine select_dim23_from4D
1558
1559       
1560        subroutine select_dim4_from4D(ntime,nlev,nlat,nlon, &
1561     &          var,vec,itime,ilev,ilat)
1562        implicit none
1563
1564        ! inputs
1565        integer ntime,nlev,nlat,nlon
1566        real var(ntime,nlev,nlat,nlon)
1567        integer itime,ilev,ilat
1568        ! outputs
1569        real vec(nlon)
1570        ! locals
1571        integer ilon
1572
1573        do ilon=1,nlon
1574          vec(ilon)=var(itime,ilev,ilat,ilon)
1575        enddo
1576
1577        return
1578        end subroutine select_dim4_from4D
1579
1580        subroutine select_dim5_from5D(n1,n2,n3,n4,n5, &
1581     &          var,vec,i1,i2,i3,i4)
1582        implicit none
1583
1584        ! inputs
1585        integer n1,n2,n3,n4,n5
1586        real var(n1,n2,n3,n4,n5)
1587        integer i1,i2,i3,i4
1588        ! outputs
1589        real vec(n5)
1590        ! locals
1591        integer i5
1592
1593        do i5=1,n5
1594          vec(i5)=var(i1,i2,i3,i4,i5)
1595        enddo
1596
1597        end subroutine select_dim5_from5D
1598
1599       
1600        subroutine select_dim3_from3D(ntime,nlat,nlon, &
1601     &          var,vec,itime,ilat)
1602        implicit none
1603
1604        ! inputs
1605        integer ntime,nlat,nlon
1606        real var(ntime,nlat,nlon)
1607        integer itime,ilat
1608        ! outputs
1609        real vec(nlon)
1610        ! locals
1611        integer ilon
1612
1613        do ilon=1,nlon
1614          vec(ilon)=var(itime,ilat,ilon)
1615        enddo
1616
1617        end subroutine select_dim3_from3D
1618
1619       
1620        subroutine select_dim23_from3D(n1,n2,n3, &
1621     &          var,vec,i1)
1622        implicit none
1623
1624        ! inputs
1625        integer n1,n2,n3
1626        real var(n1,n2,n3)
1627        integer i1
1628        ! outputs
1629        real vec(n2,n3)
1630        ! locals
1631        integer i2,i3
1632
1633        do i2=1,n2
1634         do i3=1,n3
1635          vec(i2,i3)=var(i1,i2,i3)
1636         enddo
1637        enddo
1638
1639        end subroutine select_dim23_from3D
1640
1641        subroutine putinto_dim23_from4D(n1,n2,n3,n4, &
1642     &          var,vec,i1,i4)
1643        implicit none
1644
1645        ! inputs
1646        integer n1,n2,n3,n4
1647        real vec(n2,n3)
1648        integer i1,i4
1649        ! inout
1650        real var(n1,n2,n3,n4)
1651        ! locals
1652        integer i2,i3
1653
1654       do i2=1,n2
1655        do i3=1,n3
1656          var(i1,i2,i3,i4)=vec(i2,i3)
1657         enddo
1658        enddo
1659
1660        end subroutine putinto_dim23_from4D
1661
1662       
1663        subroutine putinto_dim12_from4D(n1,n2,n3,n4, &
1664     &          var,vec,i3,i4)
1665        implicit none
1666
1667        ! inputs
1668        integer n1,n2,n3,n4
1669        real vec(n1,n2)
1670        integer i3,i4
1671        ! inout
1672        real var(n1,n2,n3,n4)
1673        ! locals
1674        integer i1,i2
1675
1676       do i1=1,n1
1677        do i2=1,n2
1678          var(i1,i2,i3,i4)=vec(i1,i2)
1679         enddo
1680        enddo
1681
1682        end subroutine putinto_dim12_from4D
1683       
1684        subroutine putinto_dim23_from3D(n1,n2,n3, &
1685     &          var,vec,i1)
1686        implicit none
1687
1688        ! inputs
1689        integer n1,n2,n3
1690        real vec(n2,n3)
1691        integer i1
1692        ! inout
1693        real var(n1,n2,n3)
1694        ! locals
1695        integer i2,i3
1696
1697       do i2=1,n2
1698        do i3=1,n3
1699          var(i1,i2,i3)=vec(i2,i3)
1700         enddo
1701        enddo
1702
1703        end subroutine putinto_dim23_from3D
1704
1705       
1706
1707        subroutine iso_verif_noNaN_par2D(x,err_msg,ni,n,m,ib,ie)
1708        implicit none
1709        ! si x est NaN, on affiche message
1710        ! d'erreur et return 1 si erreur
1711
1712        ! input:
1713          integer n,m,ni,ib,ie
1714        real x(ni,n,m)
1715        character*(*) err_msg ! message d''erreur à afficher
1716
1717        ! output
1718
1719        ! locals       
1720        integer i,j,ixt
1721
1722      do i=ib,ie
1723       do j=1,m
1724        do ixt=1,ni
1725         if ((x(ixt,i,j).gt.-borne).and. &
1726     &            (x(ixt,i,j).lt.borne)) then
1727         else !if ((x(ixt,i,j).gt.-borne).and.
1728            write(*,*) 'erreur detectee par iso_verif_nonNAN:'
1729            write(*,*) err_msg
1730            write(*,*) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
1731            stop
1732         endif  !if ((x(ixt,i,j).gt.-borne).and.
1733        enddo !do ixt=1,ni
1734       enddo !do j=1,m
1735      enddo !do i=1,n     
1736
1737#ifdef ISOVERIF
1738#else
1739        write(*,*) 'err_msg iso1772=',err_msg,': pourquoi verif?'
1740        stop
1741#endif           
1742
1743        return
1744        end subroutine iso_verif_noNaN_par2D
1745
1746       
1747        subroutine iso_verif_aberrant_enc_par2D( &
1748     &           xt,q,err_msg,ni,n,m,ib,ie)
1749
1750        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1751          implicit none
1752
1753          ! inputs   
1754          integer n,m,ni,ib,ie
1755          real q(n,m)
1756          real xt(ni,n,m)
1757          character*(*) err_msg
1758
1759        ! locals
1760        integer iso_verif_aberrant_nostop_loc
1761        integer i,j
1762        integer ifaux,jfaux
1763        !real deltaD
1764
1765        if (iso_HDO.gt.0) then
1766        iso_verif_aberrant_nostop_loc=0
1767        do i=ib,ie
1768         do j=1,m
1769          if (q(i,j).gt.ridicule) then
1770            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1771     &                   .gt.deltalim).or. &
1772     &          ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1773     &                   .lt.deltaDmin)) then   
1774              iso_verif_aberrant_nostop_loc=1
1775              ifaux=i
1776              jfaux=j
1777           endif
1778          endif
1779         enddo !do j=1,m
1780        enddo !do i=1,n
1781
1782        if (iso_verif_aberrant_nostop_loc.eq.1) then
1783          write(*,*) 'erreur detectee par iso_verif_aberrant_par2D:'
1784          write(*,*) err_msg
1785          write(*,*) 'i,j=',ifaux,jfaux
1786          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1787     &           /q(ifaux,jfaux))
1788          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1789          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1790          stop
1791        endif 
1792        endif !if (iso_HDO.gt.0) then
1793
1794        end subroutine iso_verif_aberrant_enc_par2D       
1795
1796       
1797          subroutine iso_verif_egalite_par2D( &
1798     &           xt,q,err_msg,ni,n,m,ib,ie)
1799       
1800        USE isotopes_mod, ONLY: iso_eau
1801          implicit none
1802
1803          ! inputs
1804          integer n,m,ni,ib,ie
1805          real q(n,m)
1806          real xt(ni,n,m)
1807          character*(*) err_msg
1808
1809        ! locals
1810        integer iso_verif_egalite_nostop_loc
1811        integer i,j
1812        integer ifaux,jfaux
1813
1814        if (iso_eau.gt.0) then
1815        iso_verif_egalite_nostop_loc=0
1816        do i=ib,ie
1817         do j=1,m
1818          if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1819           if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1820     &           max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1821     &           .gt.errmaxrel) then
1822              iso_verif_egalite_nostop_loc=1
1823              ifaux=i
1824              jfaux=j
1825           endif
1826          endif
1827         enddo !do j=1,m
1828        enddo !do i=1,n
1829
1830        if (iso_verif_egalite_nostop_loc.eq.1) then
1831          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
1832          write(*,*) err_msg
1833          write(*,*) 'i,j=',ifaux,jfaux
1834          write(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1835          stop
1836        endif
1837        endif
1838
1839        end subroutine iso_verif_egalite_par2D
1840
1841#ifdef ISOTRAC
1842
1843      function iso_verif_traceur_choix_nostop(x,err_msg, &
1844     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
1845        use isotopes_mod, ONLY: iso_HDO
1846        implicit none
1847        ! vérifier des choses sur les traceurs
1848        ! * toutes les zones donne t l'istope total
1849        ! * pas de deltaD aberrant
1850       
1851       ! inputs
1852       real x(ntraciso)
1853       character*(*) err_msg ! message d''erreur à afficher
1854       real errmax,errmaxrel,ridicule_trac,deltalimtrac
1855
1856       ! output
1857       integer iso_verif_traceur_choix_nostop
1858
1859       ! locals
1860       !integer iso_verif_traceur_noNaN_nostop
1861       !integer iso_verif_tracm_choix_nostop
1862       !integer iso_verif_tracdD_choix_nostop
1863       !integer iso_verif_tracpos_choix_nostop
1864
1865        iso_verif_traceur_choix_nostop=0 
1866
1867        ! verif noNaN
1868        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1869             iso_verif_traceur_choix_nostop=1
1870        endif
1871       
1872        ! verif masse
1873        if (iso_verif_tracm_choix_nostop(x,err_msg, &
1874     &           errmax,errmaxrel).eq.1) then
1875             iso_verif_traceur_choix_nostop=1
1876        endif             
1877
1878        ! verif deltaD
1879        if (iso_HDO.gt.0) then
1880        if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1881     &           ridicule_trac,deltalimtrac).eq.1) then
1882             iso_verif_traceur_choix_nostop=1
1883        endif 
1884        endif !if (iso_HDO.gt.0) then 
1885
1886        ! verif pas aberramment negatif
1887        if (iso_verif_tracpos_choix_nostop(x,err_msg, &
1888     &           1e-5).eq.1) then
1889             iso_verif_traceur_choix_nostop=1
1890        endif
1891
1892        end function iso_verif_traceur_choix_nostop
1893
1894        function iso_verif_tracnps_choix_nostop(x,err_msg, &
1895     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
1896        USE isotopes_mod, ONLY: iso_HDO
1897        implicit none
1898        ! vérifier des choses sur les traceurs
1899        ! * toutes les zones donne t l'istope total
1900        ! * pas de deltaD aberrant
1901        ! on ne vérfie pas la positivité
1902       
1903       ! inputs
1904       real x(ntraciso)
1905       character*(*) err_msg ! message d''erreur à afficher
1906       real errmax,errmaxrel,ridicule_trac,deltalimtrac
1907
1908       ! output
1909       integer iso_verif_tracnps_choix_nostop
1910
1911       ! locals
1912       !integer iso_verif_traceur_noNaN_nostop
1913       !integer iso_verif_tracm_choix_nostop
1914       !integer iso_verif_tracdD_choix_nostop
1915
1916        iso_verif_tracnps_choix_nostop=0 
1917
1918        ! verif noNaN
1919        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1920             iso_verif_tracnps_choix_nostop=1
1921        endif
1922       
1923        ! verif masse
1924        if (iso_verif_tracm_choix_nostop(x,err_msg, &
1925     &           errmax,errmaxrel).eq.1) then
1926             iso_verif_tracnps_choix_nostop=1
1927        endif             
1928
1929        ! verif deltaD
1930        if (iso_HDO.gt.0) then
1931        if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1932     &           ridicule_trac,deltalimtrac).eq.1) then
1933             iso_verif_tracnps_choix_nostop=1
1934        endif   
1935        endif ! if (iso_HDO.gt.0) then 
1936
1937        return
1938        end function iso_verif_tracnps_choix_nostop
1939
1940        function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
1941        use isotopes_mod, only: isoName
1942        implicit none
1943
1944        ! inputs
1945       real x(ntraciso)
1946       character*(*) err_msg ! message d''erreur à afficher
1947       real seuil
1948
1949       ! output
1950       integer iso_verif_tracpos_choix_nostop
1951
1952       ! locals
1953       integer lnblnk
1954       integer iiso,ixt
1955       !integer iso_verif_positif_choix_nostop
1956
1957       iso_verif_tracpos_choix_nostop=0
1958
1959       do ixt=niso+1,ntraciso
1960          if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
1961     &           ', verif positif, iso'//TRIM(isoName(ixt))).eq.1) then
1962            iso_verif_tracpos_choix_nostop=1
1963          endif
1964        enddo
1965
1966        end function iso_verif_tracpos_choix_nostop
1967
1968
1969        function iso_verif_traceur_noNaN_nostop(x,err_msg)
1970        use isotopes_mod, only: isoName
1971        implicit none
1972
1973        ! on vérifie juste que pas NaN
1974        ! inputs
1975       real x(ntraciso)
1976       character*(*) err_msg ! message d''erreur à afficher
1977
1978       ! output
1979       integer iso_verif_traceur_noNaN_nostop
1980
1981       ! locals
1982       integer lnblnk
1983       integer iiso,ixt
1984       !integer iso_verif_nonaN_nostop
1985
1986       iso_verif_traceur_noNaN_nostop=0
1987
1988        do ixt=niso+1,ntraciso
1989!          write(*,*) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
1990          if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
1991     &           ', verif trac no NaN, iso'//TRIM(isoName(ixt))) &
1992     &           .eq.1) then
1993            iso_verif_traceur_noNaN_nostop=1
1994          endif
1995        enddo
1996
1997        end function iso_verif_traceur_noNaN_nostop
1998
1999        function iso_verif_tracm_choix_nostop(x,err_msg, &
2000     &           errmaxin,errmaxrelin)
2001
2002        use isotopes_mod, ONLY: ridicule,isoName
2003        ! on vérifie juste bilan de masse
2004        implicit none
2005       
2006        ! inputs
2007        real x(ntraciso)
2008        character*(*) err_msg ! message d''erreur à afficher
2009        real errmaxin,errmaxrelin
2010
2011        ! output
2012        integer iso_verif_tracm_choix_nostop
2013
2014       ! locals
2015       !integer iso_verif_egalite_choix_nostop
2016       integer iiso,izone,ixt
2017       real xtractot
2018
2019       iso_verif_tracm_choix_nostop=0
2020
2021        do iiso=1,niso
2022
2023          xtractot=0.0
2024          do izone=1,nzone 
2025            ixt=itZonIso(izone,iiso)
2026            xtractot=xtractot+x(ixt)
2027          enddo
2028
2029          if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
2030     &        err_msg//', verif trac egalite, iso '// &
2031     &        TRIM(isoName(iiso)), &
2032     &        errmaxin,errmaxrelin).eq.1) then
2033            write(*,*) 'iso_verif_traceur 202: x=',x
2034!            write(*,*) 'xtractot=',xtractot
2035            iso_verif_tracm_choix_nostop=1
2036          endif
2037
2038          ! verif ajoutée le 19 fev 2011
2039          if ((abs(xtractot).lt.ridicule**2).and. &
2040     &           (abs(x(iiso)).gt.ridicule)) then
2041            write(*,*) err_msg,', verif masse traceurs, iso ', &
2042     &          TRIM(isoName(iiso))
2043            write(*,*) 'iso_verif_traceur 209: x=',x
2044!            iso_verif_tracm_choix_nostop=1
2045          endif
2046
2047        enddo !do iiso=1,ntraceurs_iso 
2048
2049        end function iso_verif_tracm_choix_nostop
2050
2051        function iso_verif_tracdD_choix_nostop(x,err_msg, &
2052     &           ridicule_trac,deltalimtrac)
2053
2054        USE isotopes_mod, ONLY: iso_eau, iso_HDO
2055        use isotrac_mod, only: strtrac
2056        ! on vérifie juste deltaD
2057        implicit none
2058               
2059        ! inputs
2060        real x(ntraciso)
2061        character*(*) err_msg ! message d''erreur à afficher
2062        real ridicule_trac,deltalimtrac
2063
2064        ! output
2065        integer iso_verif_tracdD_choix_nostop       
2066
2067       ! locals
2068       integer izone,ieau,ixt
2069       !integer iso_verif_aberrant_choix_nostop
2070
2071        iso_verif_tracdD_choix_nostop=0
2072
2073        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2074        do izone=1,nzone
2075             ieau=itZonIso(izone,iso_eau)
2076             ixt=itZonIso(izone,iso_HDO)
2077
2078             if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
2079     &           ridicule_trac,deltalimtrac,err_msg// &
2080     &           ', verif trac no aberrant zone '//strtrac(izone)) &
2081     &           .eq.1) then
2082               iso_verif_tracdD_choix_nostop=1
2083             endif
2084!             if (x(ieau).gt.ridicule) then
2085!              call iso_verif_aberrant(x(ixt)/x(ieau),
2086!     :           err_msg//', verif trac no aberrant zone '
2087!     :           //strtrac(izone))
2088!             endif
2089        enddo !do izone=1,nzone
2090       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2091
2092       end function iso_verif_tracdD_choix_nostop
2093
2094INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
2095  USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
2096  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
2097  IMPLICIT NONE
2098  REAL,             INTENT(IN) :: x(ntraciso)
2099  CHARACTER(LEN=*), INTENT(IN) :: err_msg
2100  INTEGER :: ieau, ixt, ieau1
2101  res = 0
2102  IF(ALL([17,18]/=option_traceurs)) RETURN
2103  !--- Check whether * deltaD(highest tagging layer) < 200 permil
2104  !                  * q <
2105  ieau=itZonIso(nzone_temp,iso_eau)
2106  ixt=itZonIso(nzone_temp,iso_HDO)
2107  IF(x(ieau)>ridicule) THEN
2108    IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
2109      res=1; write(*,*) 'x=',x
2110    END IF
2111  END IF
2112  IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
2113    res=1; write(*,*) 'x=',x
2114  END IF
2115  !--- Check whether q is small ; then, qt01 < 10%
2116  IF(x(iso_eau)<2.0e-3) THEN
2117    ieau1= itZonIso(1,iso_eau)
2118    IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
2119      res=1; write(*,*) 'x=',x
2120    END IF
2121  END IF
2122END FUNCTION iso_verif_tag17_q_deltaD_chns
2123
2124SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
2125  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
2126  IMPLICIT NONE
2127  REAL,             INTENT(IN) :: x(ntraciso)
2128  CHARACTER(LEN=*), INTENT(IN) :: err_msg
2129  IF(ALL([17,18]/=option_traceurs)) RETURN
2130  IF(nzone_temp>=5) THEN
2131    IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
2132  END IF
2133END SUBROUTINE iso_verif_trac17_q_deltaD
2134
2135      subroutine iso_verif_traceur(x,err_msg)
2136        use isotrac_mod, only: ridicule_trac
2137        implicit none
2138        ! vérifier des choses sur les traceurs
2139        ! * toutes les zones donne t l'istope total
2140        ! * pas de deltaD aberrant
2141
2142        ! on prend les valeurs pas défaut pour
2143        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2144       
2145       ! inputs
2146       real x(ntraciso)
2147       character*(*) err_msg ! message d''erreur à afficher
2148
2149       ! locals
2150       !integer iso_verif_traceur_choix_nostop 
2151
2152        if (iso_verif_traceur_choix_nostop(x,err_msg, &
2153     &       errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2154     &       .eq.1) then
2155                stop
2156        endif
2157
2158        end subroutine iso_verif_traceur
2159
2160       
2161      subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2162     &           i1,i2,i3,err_msg)
2163        use isotrac_mod, only: ridicule_trac
2164
2165        implicit none
2166        ! vérifier des choses sur les traceurs
2167        ! * toutes les zones donne t l'istope total
2168        ! * pas de deltaD aberrant
2169
2170        ! on prend les valeurs pas défaut pour
2171        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2172       
2173       ! inputs
2174       integer n1,n2,n3
2175       real x(n1,n2,n3,ntraciso)
2176       character*(*) err_msg ! message d''erreur à afficher
2177       integer i1,i2,i3
2178
2179       ! locals
2180       !integer iso_verif_traceur_choix_nostop 
2181       real xiso(ntraciso)
2182
2183        call select_dim4_from4D(n1,n2,n3,ntraciso, &
2184     &      x,xiso,i1,i2,i3)
2185        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2186     &       errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2187     &       .eq.1) then
2188                stop
2189        endif
2190
2191        end subroutine iso_verif_traceur_retourne3D
2192
2193        subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2194     &           i1,i2,i3,i4,err_msg)
2195        use isotrac_mod, only: ridicule_trac
2196
2197        implicit none
2198        ! vérifier des choses sur les traceurs
2199        ! * toutes les zones donne t l'istope total
2200        ! * pas de deltaD aberrant
2201
2202        ! on prend les valeurs pas défaut pour
2203        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2204       
2205       ! inputs
2206       integer n1,n2,n3,n4
2207       real x(n1,n2,n3,n4,ntraciso)
2208       character*(*) err_msg ! message d''erreur à afficher
2209       integer i1,i2,i3,i4
2210
2211       ! locals
2212       !integer iso_verif_traceur_choix_nostop 
2213       real xiso(ntraciso)
2214
2215        call select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2216     &      x,xiso,i1,i2,i3,i4)
2217        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2218     &       errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2219     &       .eq.1) then
2220                stop
2221        endif
2222
2223        end subroutine iso_verif_traceur_retourne4D
2224
2225       
2226      subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
2227     &           i1,i2,err_msg)
2228        use isotrac_mod, only: ridicule_trac
2229        implicit none
2230        ! vérifier des choses sur les traceurs
2231        ! * toutes les zones donne t l'istope total
2232        ! * pas de deltaD aberrant
2233
2234        ! on prend les valeurs pas défaut pour
2235        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2236       
2237       ! inputs
2238       integer n1,n2
2239       real x(n1,n2,ntraciso)
2240       character*(*) err_msg ! message d''erreur à afficher
2241       integer i1,i2
2242
2243       ! locals
2244       !integer iso_verif_traceur_choix_nostop 
2245       real xiso(ntraciso)
2246
2247        call select_dim3_from3D(n1,n2,ntraciso, &
2248     &      x,xiso,i1,i2)
2249        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2250     &       errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2251     &       .eq.1) then
2252                stop
2253        endif
2254
2255        end subroutine iso_verif_traceur_retourne2D
2256
2257        subroutine iso_verif_traceur_vect(x,n,m,err_msg)
2258        USE isotopes_mod, ONLY: iso_HDO
2259        implicit none
2260        ! vérifier des choses sur les traceurs
2261        ! * toutes les zones donne t l'istope total
2262        ! * pas de deltaD aberrant
2263
2264        ! on prend les valeurs pas défaut pour
2265        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2266       
2267       ! inputs
2268       integer n,m
2269       real x(ntraciso,n,m)
2270       character*(*) err_msg ! message d''erreur à afficher
2271
2272       ! locals
2273       logical iso_verif_traceur_nostop
2274       integer i,j,ixt,iiso,izone,ieau
2275       integer ifaux,jfaux,ixtfaux
2276       
2277       call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)       
2278
2279        ! verif masse: iso_verif_tracm_choix_nostop
2280        call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2281
2282        ! verif deltaD: iso_verif_tracdD_choix_nostop   
2283        if (iso_HDO.gt.0) then 
2284        call iso_verif_tracdd_vect(x,n,m,err_msg)     
2285        endif !if (iso_HDO.gt.0) then       
2286
2287        ! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2288        call iso_verif_tracpos_vect(x,n,m,err_msg,1e-5) 
2289       
2290        end subroutine iso_verif_traceur_vect
2291
2292        subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
2293        USE isotopes_mod, ONLY: iso_HDO
2294        implicit none
2295        ! vérifier des choses sur les traceurs
2296        ! * toutes les zones donne t l'istope total
2297        ! * pas de deltaD aberrant
2298
2299        ! on prend les valeurs pas défaut pour
2300        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2301       
2302       ! inputs
2303       integer n,m
2304       real x(ntraciso,n,m)
2305       character*(*) err_msg ! message d''erreur à afficher
2306
2307       ! locals
2308       logical iso_verif_traceur_nostop
2309       integer i,j,ixt,iiso,izone,ieau
2310       integer ifaux,jfaux,ixtfaux
2311       
2312       call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)       
2313
2314        ! verif masse: iso_verif_tracm_choix_nostop
2315        call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2316
2317        ! verif deltaD: iso_verif_tracdD_choix_nostop   
2318        if (iso_HDO.gt.0) then 
2319        call iso_verif_tracdd_vect(x,n,m,err_msg)     
2320        endif !if (iso_HDO.gt.0) then       
2321       
2322        end subroutine iso_verif_tracnps_vect
2323
2324
2325        subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2326        implicit none
2327       
2328       ! inputs
2329       integer n,m
2330       real x(ntraciso,n,m)
2331       character*(*) err_msg ! message d''erreur à afficher
2332
2333       ! locals
2334       logical iso_verif_traceur_nostop
2335       integer i,j,ixt,iiso
2336       integer ifaux,jfaux,ixtfaux
2337
2338
2339       iso_verif_traceur_nostop=.false.
2340        ! verif noNaN: iso_verif_traceur_noNaN_nostop       
2341        do j=1,m
2342        do i=1,n
2343        do ixt=niso+1,ntraciso
2344          if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) then
2345          else !if ((x.gt.-borne).and.(x.lt.borne)) then
2346              iso_verif_traceur_nostop=.true.
2347              ifaux=i
2348              jfaux=i
2349          endif !if ((x.gt.-borne).and.(x.lt.borne)) then
2350        enddo !do ixt=niso+1,ntraciso
2351        enddo ! do i=1,n
2352        enddo ! do j=1,m
2353       
2354
2355        if (iso_verif_traceur_nostop) then
2356            write(*,*) 'erreur detectée par iso_verif_nonNAN ', &
2357     &           'dans iso_verif_traceur_vect'
2358            write(*,*) ''
2359            write(*,*) err_msg
2360            write(*,*) 'x=',x(:,ifaux,jfaux)
2361            stop
2362        endif
2363
2364        end subroutine iso_verif_traceur_noNaN_vect
2365
2366       
2367        subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
2368     &            errmax,errmaxrel)
2369        use isotopes_mod, only: isoName
2370        implicit none
2371       
2372        ! inputs
2373       integer n,m
2374       real x(ntraciso,n,m)
2375       character*(*) err_msg ! message d''erreur à afficher
2376       real errmax,errmaxrel
2377
2378       ! locals
2379       logical iso_verif_traceur_nostop
2380       integer i,j,ixt,iiso,izone
2381       integer ifaux,jfaux,ixtfaux
2382       real xtractot(n,m)
2383       real xiiso(n,m)
2384
2385        do iiso=1,niso       
2386        do j=1,m
2387         do i=1,n       
2388          xtractot(i,j)=0.0
2389          xiiso(i,j)=x(iiso,i,j)
2390          do izone=1,nzone
2391            ixt=itZonIso(izone,iiso)
2392            xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)           
2393          enddo !do izone=1,nzone
2394         enddo !do i=1,n
2395        enddo !do j=1,m
2396       
2397
2398        call iso_verif_egalite_std_vect( &
2399     &           xtractot,xiiso, &
2400     &           err_msg//', verif trac egalite, iso ' &
2401     &           //TRIM(isoName(iiso)), &
2402     &           n,m,errmax,errmaxrel)
2403        enddo !do iiso=1,niso
2404
2405        end subroutine iso_verif_trac_masse_vect
2406
2407        subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
2408        use isotopes_mod, only: iso_HDO,iso_eau
2409        use isotrac_mod, only: strtrac
2410        implicit none
2411       
2412        ! inputs
2413       integer n,m
2414       real x(ntraciso,n,m)
2415       character*(*) err_msg ! message d''erreur à afficher
2416
2417       ! locals
2418       integer i,j,iiso,izone,ieau,ixt
2419       real xiiso(niso,n,m)
2420       real xeau(n,m)
2421       integer lnblnk
2422
2423       if (iso_HDO.gt.0) then
2424        do izone=1,nzone
2425          ieau=itZonIso(izone,iso_eau)
2426          do iiso=1,niso
2427           ixt=itZonIso(izone,iiso)
2428           do j=1,m
2429            do i=1,n
2430             xiiso(iiso,i,j)=x(ixt,i,j)
2431            enddo !do i=1,n
2432           enddo !do j=1,m
2433          enddo !do iiso=1,niso
2434           
2435          do j=1,m
2436           do i=1,n
2437            xeau(i,j)=x(ieau,i,j)
2438           enddo !do i=1,n
2439          enddo !do j=1,m
2440         
2441          call iso_verif_aberrant_vect2Dch( &
2442     &           xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2443     &           deltalimtrac)
2444         enddo !do izone=1,nzone
2445        endif !if (iso_HDO.gt.0) then
2446
2447        end subroutine iso_verif_tracdd_vect
2448
2449        subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2450        implicit none
2451
2452       ! inputs
2453       integer n,m
2454       real x(ntraciso,n,m)
2455       character*(*) err_msg ! message d''erreur à afficher
2456       real seuil
2457
2458       ! locals
2459       integer i,j,ixt
2460       logical iso_verif_traceur_nostop
2461       integer ifaux,jfaux,ixtfaux
2462
2463        iso_verif_traceur_nostop=.false.       
2464        do j=1,m
2465        do i=1,n
2466        do ixt=niso+1,ntraciso
2467          if (x(ixt,i,j).lt.-seuil) then
2468              ifaux=i
2469              jfaux=j
2470              ixtfaux=ixt
2471              iso_verif_traceur_nostop=.true.
2472          endif
2473        enddo !do ixt=niso+1,ntraciso
2474        enddo !do i=1,n
2475        enddo !do j=1,m       
2476
2477        if (iso_verif_traceur_nostop) then
2478            write(*,*) 'erreur detectée par verif positif ', &
2479     &           'dans iso_verif_traceur_vect'
2480            write(*,*) ''
2481            write(*,*) err_msg
2482            write(*,*) 'x=',x(:,ifaux,jfaux)
2483            stop
2484        endif
2485
2486        end subroutine iso_verif_tracpos_vect
2487
2488
2489
2490        subroutine iso_verif_tracnps(x,err_msg)
2491        use isotrac_mod, only: ridicule_trac
2492
2493        implicit none
2494        ! vérifier des choses sur les traceurs
2495        ! * toutes les zones donne t l'istope total
2496        ! * pas de deltaD aberrant
2497
2498        ! on prend les valeurs pas défaut pour
2499        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2500       
2501       ! inputs
2502       real x(ntraciso)
2503       character*(*) err_msg ! message d''erreur à afficher
2504
2505       ! locals
2506       !integer iso_verif_tracnps_choix_nostop 
2507
2508        if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2509     &       errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2510     &       .eq.1) then
2511                stop
2512        endif
2513
2514        end subroutine iso_verif_tracnps
2515
2516        subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
2517        implicit none
2518        ! vérifier des choses sur les traceurs
2519        ! * toutes les zones donne t l'istope total
2520        ! * pas de deltaD aberrant
2521
2522        ! on prend les valeurs pas défaut pour
2523        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2524       
2525       ! inputs
2526       real x(ntraciso)
2527       character*(*) err_msg ! message d''erreur à afficher
2528       real seuil
2529
2530       ! locals
2531       !integer iso_verif_tracpos_choix_nostop 
2532
2533        if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2534     &       .eq.1) then
2535                stop
2536        endif
2537
2538        end subroutine iso_verif_tracpos_choix
2539
2540        subroutine iso_verif_traceur_choix(x,err_msg, &
2541     &       errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2542        implicit none
2543        ! vérifier des choses sur les traceurs
2544        ! * toutes les zones donne t l'istope total
2545        ! * pas de deltaD aberrant
2546       
2547       ! inputs
2548       real x(ntraciso)
2549       character*(*) err_msg ! message d''erreur à afficher
2550       real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2551
2552       ! locals
2553       !integer iso_verif_traceur_choix_nostop 
2554
2555        if (iso_verif_traceur_choix_nostop(x,err_msg, &
2556     &       errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2557     &       .eq.1) then
2558                stop
2559        endif
2560
2561        end subroutine iso_verif_traceur_choix
2562
2563        function iso_verif_traceur_nostop(x,err_msg)
2564        use isotrac_mod, only: ridicule_trac
2565        !use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
2566        implicit none
2567        ! vérifier des choses sur les traceurs
2568        ! * toutes les zones donne t l'istope total
2569        ! * pas de deltaD aberrant
2570
2571        ! on prend les valeurs pas défaut pour
2572        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2573       
2574       ! inputs
2575       real x(ntraciso)
2576       character*(*) err_msg ! message d''erreur à afficher
2577
2578       ! output
2579       integer iso_verif_traceur_nostop
2580
2581       ! locals
2582       !integer iso_verif_traceur_choix_nostop 
2583
2584        iso_verif_traceur_nostop= &
2585     &       iso_verif_traceur_choix_nostop(x,err_msg, &
2586     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
2587
2588        end function iso_verif_traceur_nostop
2589
2590
2591      subroutine iso_verif_traceur_justmass(x,err_msg)
2592        implicit none
2593        ! on vérifie que noNaN et masse
2594
2595        ! on prend les valeurs pas défaut pour
2596        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2597       
2598       ! inputs
2599       real x(ntraciso)
2600       character*(*) err_msg ! message d''erreur à afficher
2601
2602       ! locals
2603       !integer iso_verif_traceur_noNaN_nostop
2604       !integer iso_verif_tracm_choix_nostop
2605
2606        ! verif noNaN
2607        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2608             stop
2609        endif
2610       
2611        ! verif masse
2612        if (iso_verif_tracm_choix_nostop(x,err_msg, &
2613     &           errmax,errmaxrel).eq.1) then
2614             stop
2615        endif   
2616       
2617        end subroutine iso_verif_traceur_justmass
2618
2619        function iso_verif_traceur_jm_nostop(x,err_msg)
2620        implicit none
2621        ! on vérifie que noNaN et masse
2622
2623        ! on prend les valeurs pas défaut pour
2624        ! errmax,errmaxrel,ridicule_trac,deltalimtrac
2625       
2626       ! inputs
2627       real x(ntraciso)
2628       character*(*) err_msg ! message d''erreur à afficher
2629
2630       ! output
2631       integer iso_verif_traceur_jm_nostop
2632
2633       ! locals
2634!       integer iso_verif_traceur_noNaN_nostop
2635       !integer iso_verif_tracm_choix_nostop
2636
2637        iso_verif_traceur_jm_nostop=0
2638!        ! verif noNaN
2639!        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2640!             iso_verif_traceur_jm_nostop=1
2641!        endif
2642       
2643        ! verif masse
2644        if (iso_verif_tracm_choix_nostop(x,err_msg, &
2645     &           errmax,errmaxrel).eq.1) then
2646             iso_verif_traceur_jm_nostop=1
2647        endif   
2648       
2649        end function iso_verif_traceur_jm_nostop
2650
2651        subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2652        USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2653        use isotrac_mod, only: option_traceurs,nzone_temp
2654        implicit none
2655
2656        ! inputs
2657        integer n,m
2658        real x(ntraciso,n,m)
2659        character*(*) err_msg
2660
2661        ! locals
2662        !integer iso_verif_positif_nostop
2663        !real deltaD
2664        integer ieau,ixt,ieau1
2665        integer i,k
2666
2667        if ((option_traceurs.eq.17).or. &
2668     &           (option_traceurs.eq.18)) then
2669        ! verifier que deltaD du tag de la couche la plus haute <
2670        ! 200 permil, et vérifier que son q est inférieur à
2671        ieau=itZonIso(nzone_temp,iso_eau)
2672        ixt=itZonIso(nzone_temp,iso_HDO)
2673        ieau1=itZonIso(1,iso_eau)
2674        do i=1,n
2675         do k=1,m
2676           if (x(ieau,i,k).gt.ridicule) then
2677             if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2678     &            .gt.-200.0) then
2679                write(*,*) err_msg,', vect:deltaDt05 trop fort'
2680                write(*,*) 'i,k=',i,k
2681                write(*,*) 'x(:,i,k)=',x(:,i,k)
2682                stop
2683             endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2684           endif !if (x(ieau).gt.ridicule) then
2685           if (x(ieau,i,k).gt.2.0e-3) then
2686                write(*,*) err_msg,', vect:qt05 trop fort'
2687                write(*,*) 'i,k=',i,k
2688                write(*,*) 'x(:,i,k)=',x(:,i,k)
2689                stop
2690           endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2691           if (x(iso_eau,i,k).lt.2.0e-3) then
2692                if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2693                   write(*,*) err_msg,', vect: qt01 trop abondant'
2694                   write(*,*) 'i,k=',i,k
2695                   write(*,*) 'ieau1,iso_eau,x(ieau1,i,k),', &
2696     &                 'x(iso_eau,i,k)=',ieau1,iso_eau, &
2697     &                  x(ieau1,i,k),x(iso_eau,i,k) 
2698                   write(*,*) 'x(:,i,k)=',x(:,i,k)
2699                   stop
2700                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2701            endif
2702          enddo !do k=1,m
2703        enddo !do i=1,n
2704
2705        endif !if (option_traceurs.eq.17) then
2706
2707        end subroutine iso_verif_tag17_q_deltaD_vect
2708
2709
2710        subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2711        USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2712        use isotrac_mod, only: option_traceurs,nzone_temp
2713        implicit none
2714
2715        ! inputs
2716        integer n,m,nq
2717        real x(n,m,nq,ntraciso)
2718        character*(*) err_msg
2719
2720        ! locals
2721        !integer iso_verif_positif_nostop
2722        !real deltaD
2723        integer ieau,ixt,ieau1
2724        integer i,k,iq
2725
2726        if ((option_traceurs.eq.17).or. &
2727     &           (option_traceurs.eq.18)) then
2728        ! verifier que deltaD du tag de la couche la plus haute <
2729        ! 200 permil, et vérifier que son q est inférieur à
2730        ieau=itZonIso(nzone_temp,iso_eau)
2731        ixt=itZonIso(nzone_temp,iso_HDO)
2732        ieau1=itZonIso(1,iso_eau)
2733        do iq=1,nq
2734        do i=1,n
2735         do k=1,m
2736           if (x(i,k,iq,ieau).gt.ridicule) then
2737             if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2738     &            .gt.-200.0) then
2739                write(*,*) err_msg,', vect:deltaDt05 trop fort'
2740                write(*,*) 'i,k=',i,k
2741                write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
2742                stop
2743             endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2744           endif !if (x(ieau).gt.ridicule) then
2745           if (x(i,k,iq,ieau).gt.2.0e-3) then
2746                write(*,*) err_msg,', vect:qt05 trop fort'
2747                write(*,*) 'i,k=',i,k
2748                write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
2749                stop
2750           endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2751           if (x(i,k,iq,iso_eau).lt.2.0e-3) then
2752                if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) then
2753                   write(*,*) err_msg,', vect: qt01 trop abondant'
2754                   write(*,*) 'i,k=',i,k
2755                   write(*,*) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2756     &                 'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2757     &                  x(i,k,iq,ieau1),x(i,k,iq,iso_eau) 
2758                   write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
2759                   stop
2760                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2761            endif
2762          enddo !do k=1,m
2763        enddo !do i=1,n
2764        enddo ! do iq=1,nq
2765
2766        endif !if (option_traceurs.eq.17) then
2767
2768        end subroutine iso_verif_tag17_q_deltaD_vect_ret3D
2769
2770
2771#endif
2772! endif ISOTRAC
2773
2774END MODULE isotopes_verif_mod
2775
2776#endif         
2777! endif ISOVERIF
2778
Note: See TracBrowser for help on using the repository browser.