[5726] | 1 | MODULE trcsms_idtra |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE trcsms_idtra *** |
---|
| 4 | !! TOP : TRI main model |
---|
| 5 | !!====================================================================== |
---|
| 6 | !! History : - ! 1999-10 (JC. Dutay) original code |
---|
| 7 | !! 1.0 ! 2004-03 (C. Ethe) free form + modularity |
---|
| 8 | !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation |
---|
| 9 | !!---------------------------------------------------------------------- |
---|
| 10 | #if defined key_idtra |
---|
| 11 | !!---------------------------------------------------------------------- |
---|
| 12 | !! 'key_idtra' TRI tracers |
---|
| 13 | !!---------------------------------------------------------------------- |
---|
| 14 | !! trc_sms_idtra : compute and add TRI suface forcing to TRI trends |
---|
| 15 | !! trc_idtra_cst : sets constants for TRI surface forcing computation |
---|
| 16 | !!---------------------------------------------------------------------- |
---|
| 17 | USE oce_trc ! Ocean variables |
---|
| 18 | USE par_trc ! TOP parameters |
---|
| 19 | USE trc ! TOP variables |
---|
[6046] | 20 | USE trd_oce |
---|
[5726] | 21 | USE trdtrc |
---|
| 22 | USE iom |
---|
| 23 | |
---|
| 24 | IMPLICIT NONE |
---|
| 25 | PRIVATE |
---|
| 26 | |
---|
[6164] | 27 | PUBLIC trc_sms_idtra ! called in ??? |
---|
| 28 | PUBLIC trc_sms_idtra_alloc ! called in ??? |
---|
| 29 | ! |
---|
[5726] | 30 | INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) |
---|
| 31 | INTEGER , PUBLIC :: numnatm |
---|
| 32 | REAL(wp), PUBLIC :: FDEC |
---|
[6164] | 33 | ! |
---|
| 34 | REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_idtra ! flux at surface |
---|
| 35 | REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qint_idtra ! cumulative flux |
---|
| 36 | REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: inv_idtra ! vertic. inventory |
---|
| 37 | |
---|
[5726] | 38 | ! ! coefficients for conversion |
---|
| 39 | REAL(wp) :: WTEMP |
---|
| 40 | |
---|
| 41 | |
---|
| 42 | !! * Substitutions |
---|
| 43 | # include "top_substitute.h90" |
---|
| 44 | !!---------------------------------------------------------------------- |
---|
| 45 | !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) |
---|
| 46 | !! $Id$ |
---|
| 47 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
| 48 | !!---------------------------------------------------------------------- |
---|
| 49 | |
---|
| 50 | CONTAINS |
---|
| 51 | |
---|
| 52 | SUBROUTINE trc_sms_idtra( kt ) |
---|
| 53 | !!---------------------------------------------------------------------- |
---|
| 54 | !! *** ROUTINE trc_sms_idtra *** |
---|
| 55 | !! |
---|
| 56 | !! ** Purpose : Compute the surface boundary contition on TRI 11 |
---|
| 57 | !! passive tracer associated with air-mer fluxes and add it |
---|
| 58 | !! to the general trend of tracers equations. |
---|
| 59 | !! |
---|
| 60 | !! ** Method : - get the atmospheric partial pressure - given in pico - |
---|
| 61 | !! - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3) |
---|
| 62 | !! - computation of transfert speed ( given in cm/hour ----> cm/s ) |
---|
| 63 | !! - the input function is given by : |
---|
| 64 | !! speed * ( concentration at equilibrium - concentration at surface ) |
---|
| 65 | !! - the input function is in pico-mol/m3/s and the |
---|
| 66 | !! TRI concentration in pico-mol/m3 |
---|
| 67 | !! |
---|
| 68 | !! *** For Idealized Tracers |
---|
| 69 | !! - no need for any temporal references, |
---|
| 70 | !! nor any atmospheric concentration, nor air -sea fluxes |
---|
| 71 | !! - Here we fixe surface concentration to 1.0 Tracer-Unit/m3 |
---|
| 72 | !! - Then we add a decay (radioactive-like) to this tracer concentration |
---|
| 73 | !! - the Half life deccay is chosen by the user, depending of the experiment. |
---|
| 74 | !! |
---|
| 75 | !!---------------------------------------------------------------------- |
---|
[6466] | 76 | INTEGER, INTENT( in ) :: kt ! ocean time-step index |
---|
[5726] | 77 | !! |
---|
[6466] | 78 | INTEGER :: ji, jj, jn, jl, jk |
---|
[6509] | 79 | REAL(wp) :: rlx !! relaxation time (1 day) |
---|
[5726] | 80 | !!---------------------------------------------------------------------- |
---|
[6216] | 81 | ! |
---|
| 82 | IF( nn_timing == 1 ) CALL timing_start('trc_sms_idtra') |
---|
| 83 | ! |
---|
[6509] | 84 | rlx = 10./(60. * 60. * 24.) !! relaxation time (1/10 day) |
---|
[6164] | 85 | IF (kt == nittrc000) THEN |
---|
[6201] | 86 | IF(lwp) WRITE(numout,*) ' trcsms_idtra :' |
---|
[6164] | 87 | IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~' |
---|
| 88 | IF(lwp) WRITE(numout,*) ' - idtra decay factor : ', FDEC |
---|
[6509] | 89 | IF(lwp) WRITE(numout,*) ' - relaxation time : ', rlx |
---|
[6201] | 90 | # if defined key_debug_medusa |
---|
[6206] | 91 | CALL flush(numout) |
---|
[6201] | 92 | # endif |
---|
[6213] | 93 | ! CALL idtra_init |
---|
[6164] | 94 | ENDIF |
---|
[5726] | 95 | |
---|
| 96 | ! |
---|
[6466] | 97 | inv_idtra(:,:,:) = 0.0 !! init the inventory |
---|
| 98 | qtr_idtra(:,:,:) = 0.0 !! init the air-sea flux |
---|
[6164] | 99 | DO jl = 1, jp_idtra |
---|
| 100 | jn = jp_idtra0 + jl - 1 |
---|
[5726] | 101 | |
---|
[6295] | 102 | !! DO jj = 1, jpj |
---|
| 103 | !! DO ji = 1, jpi |
---|
| 104 | DO jj = 2,jpjm1 |
---|
| 105 | DO ji = 2,jpim1 |
---|
| 106 | |
---|
[6164] | 107 | !! First, a crude version. will be much inproved later. |
---|
[6466] | 108 | qtr_idtra(ji,jj,jl) = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) * & |
---|
[6509] | 109 | fse3t(ji,jj,1) !! Air-sea Flux |
---|
[6466] | 110 | |
---|
| 111 | !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED |
---|
| 112 | !! qtr_idtra(ji,jj,jl) = 0.0 |
---|
[6164] | 113 | ENDDO |
---|
| 114 | ENDDO |
---|
| 115 | tra(:,:,1,jn) = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) * & |
---|
| 116 | tmask(:,:,1) / fse3t(:,:,1) ) |
---|
| 117 | qint_idtra(:,:,jl) = qint_idtra(:,:,jl) + & |
---|
| 118 | qtr_idtra(:,:,jl) * rdt !! Cumulative Air-sea Flux |
---|
[5726] | 119 | |
---|
[6164] | 120 | |
---|
| 121 | DO jk =1,jpk |
---|
| 122 | inv_idtra(:,:,jl) = inv_idtra(:,:,jl) + & |
---|
| 123 | (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk)) !! vertical inventory |
---|
| 124 | ENDDO |
---|
[5726] | 125 | ! |
---|
| 126 | !DECAY of OUR IDEALIZED TRACER |
---|
| 127 | ! --------------------------------------- |
---|
| 128 | |
---|
| 129 | DO jk =1,jpk |
---|
[6295] | 130 | !! DO jj=1,jpj |
---|
| 131 | !! DO ji =1,jpi |
---|
| 132 | DO jj = 2,jpjm1 |
---|
| 133 | DO ji = 2,jpim1 |
---|
| 134 | |
---|
[6829] | 135 | !! IF (trn(ji,jj,jk,jn) > 0.0) THEN |
---|
[5726] | 136 | WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC ) |
---|
[6164] | 137 | tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * & |
---|
| 138 | tmask(ji,jj,jk) |
---|
[6829] | 139 | !! ENDIF |
---|
[5726] | 140 | ENDDO |
---|
| 141 | ENDDO |
---|
| 142 | ENDDO |
---|
| 143 | |
---|
[6164] | 144 | ENDDO |
---|
[5726] | 145 | !! jn loop |
---|
| 146 | ! |
---|
[6206] | 147 | # if defined key_debug_medusa |
---|
| 148 | IF(lwp) WRITE(numout,*) ' IDTRA - calculation part - DONE trc_sms_idtra -- ' |
---|
| 149 | CALL flush(numout) |
---|
| 150 | # endif |
---|
[6164] | 151 | ! |
---|
[6206] | 152 | !! restart and diagnostics management -- |
---|
[6213] | 153 | !IF( lrst_trc ) THEN |
---|
| 154 | ! IF(lwp) WRITE(numout,*) |
---|
| 155 | ! IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ', & |
---|
| 156 | ! & 'at it= ', kt,' date= ', ndastp |
---|
| 157 | ! IF(lwp) WRITE(numout,*) '~~~~' |
---|
| 158 | ! !!DO jn = jp_idtra0, jp_idtra1 |
---|
| 159 | ! CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) ) |
---|
| 160 | ! !!END DO |
---|
| 161 | ! if defined key_debug_medusa |
---|
| 162 | ! IF(lwp) WRITE(numout,*) ' IDTRA - writing diag-restart - DONE trc_sms_idtra -- ' |
---|
| 163 | ! CALL flush(numout) |
---|
| 164 | ! endif |
---|
| 165 | !ENDIF |
---|
[6164] | 166 | ! |
---|
| 167 | CALL iom_put( "qtrIDTRA" , qtr_idtra (:,:,1) ) |
---|
| 168 | CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) |
---|
| 169 | CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) |
---|
| 170 | ! |
---|
[6207] | 171 | # if defined key_debug_medusa |
---|
| 172 | IF(lwp) WRITE(numout,*) ' IDTRA - writing diag - DONE trc_sms_idtra -- ' |
---|
| 173 | CALL flush(numout) |
---|
| 174 | # endif |
---|
| 175 | ! |
---|
[6164] | 176 | IF( l_trdtrc ) THEN |
---|
[6207] | 177 | # if defined key_debug_medusa |
---|
[6213] | 178 | IF(lwp) WRITE(numout,*) ' IDTRA - writing trends - trc_sms_idtra -- ' |
---|
| 179 | CALL flush(numout) |
---|
[6207] | 180 | # endif |
---|
[6164] | 181 | DO jn = jp_idtra0, jp_idtra1 |
---|
| 182 | CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends |
---|
| 183 | END DO |
---|
[6207] | 184 | # if defined key_debug_medusa |
---|
[6213] | 185 | IF(lwp) WRITE(numout,*) ' IDTRA - writing trends - DONE trc_sms_idtra -- ' |
---|
| 186 | CALL flush(numout) |
---|
[6207] | 187 | # endif |
---|
[6164] | 188 | END IF |
---|
| 189 | ! |
---|
[6213] | 190 | # if defined key_debug_medusa |
---|
| 191 | IF(lwp) WRITE(numout,*) ' IDTRA - Check: nn_timing = ', nn_timing |
---|
| 192 | CALL flush(numout) |
---|
| 193 | # endif |
---|
[6164] | 194 | IF( nn_timing == 1 ) CALL timing_stop('trc_sms_idtra') |
---|
| 195 | ! |
---|
[6201] | 196 | # if defined key_debug_medusa |
---|
| 197 | IF(lwp) WRITE(numout,*) ' IDTRA DONE trc_sms_idtra -- ' |
---|
| 198 | CALL flush(numout) |
---|
| 199 | # endif |
---|
| 200 | ! |
---|
[6164] | 201 | END SUBROUTINE trc_sms_idtra |
---|
[5726] | 202 | |
---|
[6206] | 203 | SUBROUTINE idtra_init |
---|
| 204 | !!--------------------------------------------------------------------- |
---|
| 205 | !! *** idtra_init *** |
---|
| 206 | !! |
---|
| 207 | !! ** Purpose : read restart values for IDTRA model |
---|
| 208 | !!--------------------------------------------------------------------- |
---|
| 209 | INTEGER :: jn |
---|
| 210 | |
---|
| 211 | IF( ln_rsttr ) THEN |
---|
| 212 | IF(lwp) WRITE(numout,*) |
---|
| 213 | IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model ' |
---|
| 214 | IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' |
---|
| 215 | ! |
---|
| 216 | DO jn = jp_idtra0, jp_idtra1 |
---|
| 217 | CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) ) |
---|
| 218 | END DO |
---|
| 219 | ENDIF |
---|
| 220 | IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK' |
---|
| 221 | ! |
---|
| 222 | END SUBROUTINE idtra_init |
---|
| 223 | |
---|
[6164] | 224 | INTEGER FUNCTION trc_sms_idtra_alloc() |
---|
| 225 | !!---------------------------------------------------------------------- |
---|
| 226 | !! *** ROUTINE trc_sms_idtra_alloc *** |
---|
| 227 | !!---------------------------------------------------------------------- |
---|
| 228 | ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) , & |
---|
| 229 | & inv_idtra(jpi,jpj,jp_idtra) , & |
---|
| 230 | & qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc ) |
---|
| 231 | ! |
---|
| 232 | IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.') |
---|
| 233 | ! |
---|
| 234 | END FUNCTION trc_sms_idtra_alloc |
---|
[5726] | 235 | |
---|
| 236 | #else |
---|
| 237 | !!---------------------------------------------------------------------- |
---|
| 238 | !! Dummy module No TRI tracers |
---|
| 239 | !!---------------------------------------------------------------------- |
---|
| 240 | CONTAINS |
---|
| 241 | SUBROUTINE trc_sms_idtra( kt ) ! Empty routine |
---|
| 242 | WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt |
---|
| 243 | END SUBROUTINE trc_sms_idtra |
---|
| 244 | #endif |
---|
| 245 | |
---|
| 246 | !!====================================================================== |
---|
| 247 | END MODULE trcsms_idtra |
---|
| 248 | |
---|
| 249 | |
---|
| 250 | |
---|
| 251 | |
---|