source: tags/LIM1D_v3.5/ice_bio_conserv.f @ 57

Last change on this file since 57 was 57, checked in by vancop, 7 years ago

initial import of source_3.5
File size: 3.3 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.