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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 @ 8442

Last change on this file since 8442 was 8442, checked in by frrh, 7 years ago

Commit changes relating to Met Office GMED ticket 340 for the
tidying of MEDUSA related code and debugging statements in the TOP code.

Only code introduced at revision 8434 of branch
http://fcm3/projects/NEMO.xm/log/branches/NERC/dev_r5518_GO6_split_trcbiomedusa
is included here, all previous revisions of that branch having been dealt with
under GMED ticket 339.

File size: 10.1 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      rlx = 10./(60. * 60. * 24.)                              !! relaxation time (1/10 day)
85      IF (kt == nittrc000) THEN
86         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
87         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
88         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
89         IF(lwp) WRITE(numout,*) '   - relaxation time    : ', rlx
90# if defined key_debug_medusa
91         CALL flush(numout)
92# endif
93      !   CALL idtra_init
94      ENDIF
95
96         !
97      inv_idtra(:,:,:) = 0.0                                   !! init the inventory
98      qtr_idtra(:,:,:) = 0.0                                   !! init the air-sea flux
99      DO jl = 1, jp_idtra
100         jn = jp_idtra0 + jl - 1
101
102      !!   DO jj = 1, jpj
103      !!      DO ji = 1, jpi
104           DO jj = 2,jpjm1
105              DO ji = 2,jpim1
106
107         !! First, a crude version. will be much inproved later.
108             qtr_idtra(ji,jj,jl)  = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
109                                  fse3t(ji,jj,1)                  !! Air-sea Flux
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
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
119
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
125!
126!DECAY of OUR IDEALIZED TRACER
127! ---------------------------------------
128
129         DO  jk =1,jpk
130      !!      DO jj=1,jpj
131      !!        DO  ji =1,jpi
132            DO jj = 2,jpjm1
133               DO ji = 2,jpim1
134           
135                 !! IF (trn(ji,jj,jk,jn) > 0.0) THEN
136                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
137                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
138                                     tmask(ji,jj,jk)
139                 !! ENDIF
140              ENDDO 
141            ENDDO
142         ENDDO
143
144      ENDDO
145    !! jn loop
146!
147# if defined key_debug_medusa
148         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- '
149      CALL flush(numout)
150# endif
151        !
152        !! restart and diagnostics management --
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
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      !
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      !
176      IF( l_trdtrc ) THEN
177# if defined key_debug_medusa
178         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- '
179         CALL flush(numout)
180# endif
181          DO jn = jp_idtra0, jp_idtra1
182            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
183          END DO
184# if defined key_debug_medusa
185         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- '
186         CALL flush(numout)
187# endif
188      END IF
189      !
190# if defined key_debug_medusa
191         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing 
192         CALL flush(numout)
193# endif
194      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
195      !
196# if defined key_debug_medusa
197         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
198      CALL flush(numout)
199# endif
200      !
201   END SUBROUTINE trc_sms_idtra
202
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
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
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Dummy module                                         No TRI tracers
239   !!----------------------------------------------------------------------
240CONTAINS
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   !!======================================================================
247END MODULE trcsms_idtra
248
249
250
251
Note: See TracBrowser for help on using the repository browser.