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

source: branches/UKMO/dev_r5518_fix_diag_bitcomp/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 @ 9502

Last change on this file since 9502 was 9502, checked in by frrh, 6 years ago

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