[6] | 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 |
---|