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 @ 6213

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

JPALM -- 05-01-2016 -- Unexpected problem appears in monsoon merged NEMO-CFC-IDTRA restarts that does not appear in this branch allone. CFC restart diag is empty. try to avoid this problem by moving diag CFC and IDTRA by writing theses in the main trcrst modules -- should check full merged model diff with this branch
File size: 9.6 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
80
81
82      !!----------------------------------------------------------------------
83      IF (kt == nittrc000) THEN
84         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
85         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
86         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
87# if defined key_debug_medusa
88         CALL flush(numout)
89# endif
90      !   CALL idtra_init
91      ENDIF
92
93         !
94      inv_idtra(:,:,:) = 0.0                                        !! init the inventory
95      DO jl = 1, jp_idtra
96         jn = jp_idtra0 + jl - 1
97
98         DO jj = 1, jpj
99            DO ji = 1, jpi
100         !! First, a crude version. will be much inproved later.
101             qtr_idtra(ji,jj,jl)  = (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
102                                  fse3t(ji,jj,1) / rdt             !! Air-sea Flux
103           ENDDO
104         ENDDO
105         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
106                            tmask(:,:,1) / fse3t(:,:,1) )
107         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
108                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux
109
110
111         DO jk =1,jpk
112            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
113                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
114         ENDDO
115!
116!DECAY of OUR IDEALIZED TRACER
117! ---------------------------------------
118
119         DO  jk =1,jpk
120            DO jj=1,jpj
121              DO  ji =1,jpi
122               !  IF (trn(ji,jj,jk,jn) > 0.0) THEN
123                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
124                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
125                                     tmask(ji,jj,jk)
126               !  ENDIF
127              ENDDO 
128            ENDDO
129         ENDDO
130
131      ENDDO
132    !! jn loop
133!
134# if defined key_debug_medusa
135         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- '
136      CALL flush(numout)
137# endif
138        !
139        !! restart and diagnostics management --
140      !IF( lrst_trc ) THEN
141      !   IF(lwp) WRITE(numout,*)
142      !   IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
143      !      &                    'at it= ', kt,' date= ', ndastp
144      !   IF(lwp) WRITE(numout,*) '~~~~'
145      !   !!DO jn = jp_idtra0, jp_idtra1
146      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
147      !   !!END DO
148 ! if defined key_debug_medusa
149      !   IF(lwp) WRITE(numout,*) '   IDTRA - writing diag-restart - DONE trc_sms_idtra -- '
150      !   CALL flush(numout)
151 ! endif
152      !ENDIF
153      !
154      IF( lk_iomput ) THEN
155         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) )
156         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) )
157         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) )
158      ELSE
159         IF( ln_diatrc ) THEN
160            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1)
161            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)
162            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)
163         END IF
164      END IF
165      !
166# if defined key_debug_medusa
167      IF(lwp) WRITE(numout,*) '   IDTRA - writing diag - DONE trc_sms_idtra -- '
168      CALL flush(numout)
169# endif
170      !
171      IF( l_trdtrc ) THEN
172# if defined key_debug_medusa
173         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- '
174         CALL flush(numout)
175# endif
176          DO jn = jp_idtra0, jp_idtra1
177            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
178          END DO
179# if defined key_debug_medusa
180         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- '
181         CALL flush(numout)
182# endif
183      END IF
184      !
185# if defined key_debug_medusa
186         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing 
187         CALL flush(numout)
188# endif
189      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
190      !
191# if defined key_debug_medusa
192         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
193      CALL flush(numout)
194# endif
195      !
196   END SUBROUTINE trc_sms_idtra
197
198   SUBROUTINE idtra_init
199      !!---------------------------------------------------------------------
200      !!                     ***  idtra_init  ***
201      !!
202      !! ** Purpose : read restart values for IDTRA model
203      !!---------------------------------------------------------------------
204      INTEGER :: jn
205
206      IF( ln_rsttr ) THEN
207         IF(lwp) WRITE(numout,*)
208         IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model '
209         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
210         !
211         DO jn = jp_idtra0, jp_idtra1
212            CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) )
213         END DO
214      ENDIF
215      IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK'
216      !
217   END SUBROUTINE idtra_init
218
219   INTEGER FUNCTION trc_sms_idtra_alloc()
220      !!----------------------------------------------------------------------
221      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
222      !!----------------------------------------------------------------------
223      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
224         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
225         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
226         !
227      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
228      !
229   END FUNCTION trc_sms_idtra_alloc
230
231#else
232   !!----------------------------------------------------------------------
233   !!   Dummy module                                         No TRI tracers
234   !!----------------------------------------------------------------------
235CONTAINS
236   SUBROUTINE trc_sms_idtra( kt )       ! Empty routine
237      WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt
238   END SUBROUTINE trc_sms_idtra
239#endif
240
241   !!======================================================================
242END MODULE trcsms_idtra
243
244
245
246
Note: See TracBrowser for help on using the repository browser.