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/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/IDTRA – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.
File size: 11.5 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   USE yomhook, ONLY: lhook, dr_hook
25   USE parkind1, ONLY: jprb, jpim
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   trc_sms_idtra        ! called in ???
31   PUBLIC   trc_sms_idtra_alloc  ! called in ???
32   !
33   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
34   INTEGER , PUBLIC    ::   numnatm
35   REAL(wp), PUBLIC    ::   FDEC
36   !
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_idtra  ! flux at surface
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_idtra ! cumulative flux
39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   inv_idtra  ! vertic. inventory
40
41   !                          ! coefficients for conversion
42   REAL(wp) ::  WTEMP
43
44
45   !! * Substitutions
46#  include "top_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
49   !! $Id$
50   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE trc_sms_idtra( kt )
56      !!----------------------------------------------------------------------
57      !!                     ***  ROUTINE trc_sms_idtra  ***
58      !!
59      !! ** Purpose :   Compute the surface boundary contition on TRI 11
60      !!             passive tracer associated with air-mer fluxes and add it
61      !!             to the general trend of tracers equations.
62      !!
63      !! ** Method  : - get the atmospheric partial pressure - given in pico -
64      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
65      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
66      !!              - the input function is given by :
67      !!                speed * ( concentration at equilibrium - concentration at surface )
68      !!              - the input function is in pico-mol/m3/s and the
69      !!                TRI concentration in pico-mol/m3
70      !!               
71      !! *** For Idealized Tracers             
72      !!              - no need for any temporal references,
73      !!              nor any atmospheric concentration, nor air -sea fluxes
74      !!              - Here we fixe surface concentration to 1.0 Tracer-Unit/m3
75      !!              - Then we add a decay (radioactive-like) to this tracer concentration
76      !!              - the Half life deccay is chosen by the user, depending of the experiment.
77      !!             
78      !!----------------------------------------------------------------------
79      INTEGER, INTENT( in )  ::   kt    ! ocean time-step index
80      !!
81      INTEGER                ::   ji, jj, jn, jl, jk
82      REAL(wp)               ::   rlx                 !! relaxation time (1 day)
83      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
84      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
85      REAL(KIND=jprb)               :: zhook_handle
86
87      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_SMS_IDTRA'
88
89      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
90
91      !!----------------------------------------------------------------------
92      !
93      IF( nn_timing == 1 )  CALL timing_start('trc_sms_idtra')
94      !
95      rlx = 10./(60. * 60. * 24.)                              !! relaxation time (1/10 day)
96      IF (kt == nittrc000) THEN
97         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
98         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
99         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
100         IF(lwp) WRITE(numout,*) '   - relaxation time    : ', rlx
101# if defined key_debug_medusa
102         CALL flush(numout)
103# endif
104      !   CALL idtra_init
105      ENDIF
106
107         !
108      inv_idtra(:,:,:) = 0.0                                   !! init the inventory
109      qtr_idtra(:,:,:) = 0.0                                   !! init the air-sea flux
110      DO jl = 1, jp_idtra
111         jn = jp_idtra0 + jl - 1
112
113      !!   DO jj = 1, jpj
114      !!      DO ji = 1, jpi
115           DO jj = 2,jpjm1
116              DO ji = 2,jpim1
117
118         !! First, a crude version. will be much inproved later.
119             qtr_idtra(ji,jj,jl)  = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
120                                  fse3t(ji,jj,1)                  !! Air-sea Flux
121
122           !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED 
123           !!  qtr_idtra(ji,jj,jl)  = 0.0
124           ENDDO
125         ENDDO
126         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
127                            tmask(:,:,1) / fse3t(:,:,1) )
128         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
129                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux
130
131
132         DO jk =1,jpk
133            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
134                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
135         ENDDO
136!
137!DECAY of OUR IDEALIZED TRACER
138! ---------------------------------------
139
140         DO  jk =1,jpk
141      !!      DO jj=1,jpj
142      !!        DO  ji =1,jpi
143            DO jj = 2,jpjm1
144               DO ji = 2,jpim1
145           
146                 !! IF (trn(ji,jj,jk,jn) > 0.0) THEN
147                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
148                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
149                                     tmask(ji,jj,jk)
150                 !! ENDIF
151              ENDDO 
152            ENDDO
153         ENDDO
154
155      ENDDO
156    !! jn loop
157!
158# if defined key_debug_medusa
159         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- '
160      CALL flush(numout)
161# endif
162        !
163        !! restart and diagnostics management --
164      !IF( lrst_trc ) THEN
165      !   IF(lwp) WRITE(numout,*)
166      !   IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
167      !      &                    'at it= ', kt,' date= ', ndastp
168      !   IF(lwp) WRITE(numout,*) '~~~~'
169      !   !!DO jn = jp_idtra0, jp_idtra1
170      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
171      !   !!END DO
172 ! if defined key_debug_medusa
173      !   IF(lwp) WRITE(numout,*) '   IDTRA - writing diag-restart - DONE trc_sms_idtra -- '
174      !   CALL flush(numout)
175 ! endif
176      !ENDIF
177      !
178         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) )
179         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) )
180         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) )
181      !
182# if defined key_debug_medusa
183      IF(lwp) WRITE(numout,*) '   IDTRA - writing diag - DONE trc_sms_idtra -- '
184      CALL flush(numout)
185# endif
186      !
187      IF( l_trdtrc ) THEN
188# if defined key_debug_medusa
189         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- '
190         CALL flush(numout)
191# endif
192          DO jn = jp_idtra0, jp_idtra1
193            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
194          END DO
195# if defined key_debug_medusa
196         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- '
197         CALL flush(numout)
198# endif
199      END IF
200      !
201# if defined key_debug_medusa
202         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing 
203         CALL flush(numout)
204# endif
205      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
206      !
207# if defined key_debug_medusa
208         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
209      CALL flush(numout)
210# endif
211      !
212      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
213   END SUBROUTINE trc_sms_idtra
214
215   SUBROUTINE idtra_init
216      !!---------------------------------------------------------------------
217      !!                     ***  idtra_init  ***
218      !!
219      !! ** Purpose : read restart values for IDTRA model
220      !!---------------------------------------------------------------------
221      INTEGER :: jn
222      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
223      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
224      REAL(KIND=jprb)               :: zhook_handle
225
226      CHARACTER(LEN=*), PARAMETER :: RoutineName='IDTRA_INIT'
227
228      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
229
230
231      IF( ln_rsttr ) THEN
232         IF(lwp) WRITE(numout,*)
233         IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model '
234         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
235         !
236         DO jn = jp_idtra0, jp_idtra1
237            CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) )
238         END DO
239      ENDIF
240      IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK'
241      !
242      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
243   END SUBROUTINE idtra_init
244
245   INTEGER FUNCTION trc_sms_idtra_alloc()
246   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
247   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
248   REAL(KIND=jprb)               :: zhook_handle
249
250   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_SMS_IDTRA_ALLOC'
251
252   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
253
254      !!----------------------------------------------------------------------
255      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
256      !!----------------------------------------------------------------------
257      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
258         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
259         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
260         !
261      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
262      !
263   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
264   END FUNCTION trc_sms_idtra_alloc
265
266#else
267   !!----------------------------------------------------------------------
268   !!   Dummy module                                         No TRI tracers
269   !!----------------------------------------------------------------------
270CONTAINS
271   SUBROUTINE trc_sms_idtra( kt )       ! Empty routine
272   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
273   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
274   REAL(KIND=jprb)               :: zhook_handle
275
276   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_SMS_IDTRA'
277
278   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
279
280      WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt
281   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
282   END SUBROUTINE trc_sms_idtra
283#endif
284
285   !!======================================================================
286END MODULE trcsms_idtra
287
288
289
290
Note: See TracBrowser for help on using the repository browser.