1 | SUBROUTINE ice_bio_conserv(kideb,kiut,ntra,message,trc_nam,err, |
---|
2 | & zmb0,zmb1,zfb,zfsu,zdt) |
---|
3 | |
---|
4 | ! This routine tests conservation of the mass of tracers |
---|
5 | ! (c) Martin Vancoppenolle, June 2007 |
---|
6 | |
---|
7 | INCLUDE 'type.com' |
---|
8 | INCLUDE 'para.com' |
---|
9 | INCLUDE 'bio.com' |
---|
10 | |
---|
11 | CHARACTER(len=15) :: |
---|
12 | & message ! : message indicating the name of the routine calling |
---|
13 | |
---|
14 | CHARACTER(len=64), DIMENSION(ntra_bio_max) :: |
---|
15 | & trc_nam ! : name of the tracer tested |
---|
16 | |
---|
17 | CHARACTER(len=19) :: |
---|
18 | & zstr1 |
---|
19 | CHARACTER(len=3) :: |
---|
20 | & zstr2 |
---|
21 | CHARACTER(len=8) :: |
---|
22 | & zstr3 |
---|
23 | |
---|
24 | REAL(8) :: |
---|
25 | & err |
---|
26 | |
---|
27 | REAL(8), DIMENSION(ntra_bio_max) :: |
---|
28 | & zmb0 , |
---|
29 | & zmb1 , |
---|
30 | & zfb , |
---|
31 | & zfsu |
---|
32 | |
---|
33 | REAL(8) :: |
---|
34 | & zdt |
---|
35 | |
---|
36 | INTEGER :: |
---|
37 | & ji , ! : index for space |
---|
38 | & jk , ! : index for ice layers |
---|
39 | & jn ! : index for tracers |
---|
40 | |
---|
41 | REAL(8) :: |
---|
42 | & zdm ! : actual mass variation |
---|
43 | & zdmf |
---|
44 | |
---|
45 | !=============================================================================! |
---|
46 | |
---|
47 | WRITE(numout,*) ' ice_bio_conserv : ' |
---|
48 | WRITE(numout,*) ' ~~~~~~~~~~~~~~~ ' |
---|
49 | WRITE(numout,*) ' message : ', message |
---|
50 | WRITE(numout,*) ' error max : ', err |
---|
51 | WRITE(numout,*) ' kideb, kiut : ', kideb, kiut |
---|
52 | WRITE(numout,*) ' ddtb : ', zdt |
---|
53 | |
---|
54 | DO jn = 1, ntra |
---|
55 | |
---|
56 | IF ( flag_active(jn) ) THEN |
---|
57 | |
---|
58 | WRITE(numout,*) ' --- Tracer : ', trc_nam(jn) |
---|
59 | WRITE(numout,*) ' jn : ', jn |
---|
60 | WRITE(numout,*) ' mt_i_bio_init : ', zmb0(jn) |
---|
61 | WRITE(numout,*) ' mt_i_bio_final : ', zmb1(jn) |
---|
62 | |
---|
63 | zdm = ( zmb1(jn) - zmb0(jn) ) / zdt |
---|
64 | zdmf = zfb(jn) + zfsu(jn) |
---|
65 | |
---|
66 | WRITE(numout,*) ' Actual mass variation zdm : ', zdm |
---|
67 | WRITE(numout,*) ' Mass variation from fluxes zdmf : ', zdmf |
---|
68 | zstr1 = ' Bio conserv error ' |
---|
69 | zstr2 = TRIM(trc_nam(jn)) |
---|
70 | WRITE(zstr3,'(E8.2)') ABS(zdm-zdmf) |
---|
71 | ! WRITE(numout,*) ' Bio conserv error : ', ABS(zdm-zdmf) |
---|
72 | WRITE(numout,*) zstr1//'in '//TRIM(message)//' ('//zstr2// |
---|
73 | & ') : '//zstr3 |
---|
74 | WRITE(503,*) zmb1(jn), ABS(zdm-zdmf)*zdt |
---|
75 | |
---|
76 | IF ( ABS ( zdm - zdmf ) .GT. err ) THEN |
---|
77 | WRITE(numout,*) ' Conservation error after ', message |
---|
78 | WRITE(numout,*) ' Error : ', |
---|
79 | & ABS( zdm - zdmf ) |
---|
80 | ! WRITE(numout,*) ' Actual mass variation zdm : ', zdm |
---|
81 | ! WRITE(numout,*) ' Mass variation from fluxes zdmf : ', zdmf |
---|
82 | WRITE(numout,*) |
---|
83 | WRITE(numout,*) ' mt_i_bio_init : ', zmb0(jn) |
---|
84 | WRITE(numout,*) ' mt_i_bio_final : ', zmb1(jn) |
---|
85 | WRITE(numout,*) ' Upper flux zfsu : ', zfsu(jn) |
---|
86 | WRITE(numout,*) ' Lower flux zfb : ', zfb(jn) |
---|
87 | WRITE(numout,*) |
---|
88 | ! WRITE(numout,*) ' c_i_bio : ', ( c_i_bio(jn,layer), |
---|
89 | ! & layer = 1, nlay_bio ) |
---|
90 | ! WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn,layer), |
---|
91 | ! & layer = 1, nlay_bio ) |
---|
92 | |
---|
93 | ENDIF ! residual |
---|
94 | |
---|
95 | ENDIF ! flag_active |
---|
96 | |
---|
97 | END DO ! jn |
---|
98 | |
---|
99 | RETURN |
---|
100 | |
---|
101 | !=============================================================================! |
---|
102 | !-- End of ice_bio_conserv -- |
---|
103 | |
---|
104 | END |
---|