New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
trcsms_idtra.F90 in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 @ 6466

Last change on this file since 6466 was 6466, checked in by jpalmier, 8 years ago

JPALM -- 11-04-2016 -- add dust deposition input through namelist

-- relax time to IDTRA surface flux
File size: 10.2 KB
Line 
1MODULE 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
20   USE trd_oce
21   USE trdtrc
22   USE iom
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   trc_sms_idtra        ! called in ???
28   PUBLIC   trc_sms_idtra_alloc  ! called in ???
29   !
30   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
31   INTEGER , PUBLIC    ::   numnatm
32   REAL(wp), PUBLIC    ::   FDEC
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
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
50CONTAINS
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      !!----------------------------------------------------------------------
76      INTEGER, INTENT( in )  ::   kt    ! ocean time-step index
77      !!
78      INTEGER                ::   ji, jj, jn, jl, jk
79      REAL(wp)               ::   rlx   !! relaxation time (1 day)
80      !!----------------------------------------------------------------------
81      !
82      IF( nn_timing == 1 )  CALL timing_start('trc_sms_idtra')
83      !
84      IF (kt == nittrc000) THEN
85         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
86         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
87         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
88# if defined key_debug_medusa
89         CALL flush(numout)
90# endif
91      !   CALL idtra_init
92      ENDIF
93
94         !
95      rlx = 1/(60 * 60 * 24)                                   !! relaxation time (1 day)
96      inv_idtra(:,:,:) = 0.0                                   !! init the inventory
97      qtr_idtra(:,:,:) = 0.0                                   !! init the air-sea flux
98      DO jl = 1, jp_idtra
99         jn = jp_idtra0 + jl - 1
100
101      !!   DO jj = 1, jpj
102      !!      DO ji = 1, jpi
103           DO jj = 2,jpjm1
104              DO ji = 2,jpim1
105
106         !! First, a crude version. will be much inproved later.
107             qtr_idtra(ji,jj,jl)  = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
108                                  fse3t(ji,jj,1) / rdt             !! Air-sea Flux
109
110           !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED 
111           !!  qtr_idtra(ji,jj,jl)  = 0.0
112           ENDDO
113         ENDDO
114         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
115                            tmask(:,:,1) / fse3t(:,:,1) )
116         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
117                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux
118
119
120         DO jk =1,jpk
121            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
122                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
123         ENDDO
124!
125!DECAY of OUR IDEALIZED TRACER
126! ---------------------------------------
127
128         DO  jk =1,jpk
129      !!      DO jj=1,jpj
130      !!        DO  ji =1,jpi
131            DO jj = 2,jpjm1
132               DO ji = 2,jpim1
133           
134               !  IF (trn(ji,jj,jk,jn) > 0.0) THEN
135                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
136                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
137                                     tmask(ji,jj,jk)
138               !  ENDIF
139              ENDDO 
140            ENDDO
141         ENDDO
142
143      ENDDO
144    !! jn loop
145!
146# if defined key_debug_medusa
147         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- '
148      CALL flush(numout)
149# endif
150        !
151        !! restart and diagnostics management --
152      !IF( lrst_trc ) THEN
153      !   IF(lwp) WRITE(numout,*)
154      !   IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
155      !      &                    'at it= ', kt,' date= ', ndastp
156      !   IF(lwp) WRITE(numout,*) '~~~~'
157      !   !!DO jn = jp_idtra0, jp_idtra1
158      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
159      !   !!END DO
160 ! if defined key_debug_medusa
161      !   IF(lwp) WRITE(numout,*) '   IDTRA - writing diag-restart - DONE trc_sms_idtra -- '
162      !   CALL flush(numout)
163 ! endif
164      !ENDIF
165      !
166      IF( lk_iomput ) THEN
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      ELSE
171         IF( ln_diatrc ) THEN
172            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1)
173            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)
174            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)
175         END IF
176      END IF
177      !
178# if defined key_debug_medusa
179      IF(lwp) WRITE(numout,*) '   IDTRA - writing diag - DONE trc_sms_idtra -- '
180      CALL flush(numout)
181# endif
182      !
183      IF( l_trdtrc ) THEN
184# if defined key_debug_medusa
185         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- '
186         CALL flush(numout)
187# endif
188          DO jn = jp_idtra0, jp_idtra1
189            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
190          END DO
191# if defined key_debug_medusa
192         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- '
193         CALL flush(numout)
194# endif
195      END IF
196      !
197# if defined key_debug_medusa
198         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing 
199         CALL flush(numout)
200# endif
201      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
202      !
203# if defined key_debug_medusa
204         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
205      CALL flush(numout)
206# endif
207      !
208   END SUBROUTINE trc_sms_idtra
209
210   SUBROUTINE idtra_init
211      !!---------------------------------------------------------------------
212      !!                     ***  idtra_init  ***
213      !!
214      !! ** Purpose : read restart values for IDTRA model
215      !!---------------------------------------------------------------------
216      INTEGER :: jn
217
218      IF( ln_rsttr ) THEN
219         IF(lwp) WRITE(numout,*)
220         IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model '
221         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
222         !
223         DO jn = jp_idtra0, jp_idtra1
224            CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) )
225         END DO
226      ENDIF
227      IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK'
228      !
229   END SUBROUTINE idtra_init
230
231   INTEGER FUNCTION trc_sms_idtra_alloc()
232      !!----------------------------------------------------------------------
233      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
234      !!----------------------------------------------------------------------
235      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
236         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
237         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
238         !
239      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
240      !
241   END FUNCTION trc_sms_idtra_alloc
242
243#else
244   !!----------------------------------------------------------------------
245   !!   Dummy module                                         No TRI tracers
246   !!----------------------------------------------------------------------
247CONTAINS
248   SUBROUTINE trc_sms_idtra( kt )       ! Empty routine
249      WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt
250   END SUBROUTINE trc_sms_idtra
251#endif
252
253   !!======================================================================
254END MODULE trcsms_idtra
255
256
257
258
Note: See TracBrowser for help on using the repository browser.