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.
trcbbc.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/trcbbc.F90 @ 1193

Last change on this file since 1193 was 1193, checked in by cetlod, 16 years ago

Correction of transport module to ensure reproductibility for TOP configurations, see ticket:253
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 10.4 KB
Line 
1MODULE trcbbc
2   !!======================================================================
3   !!                       ***  MODULE  trcbbc  ***
4   !! Ocean passive tracers:  bottom boundary condition
5   !!======================================================================
6   !! History :  8.1  !  99-10  (G. Madec)  original code
7   !!            8.5  !  02-08  (G. Madec)  free form + modules
8   !!                 !  02-11  (A. Bozec)  trc_bbc_init
9   !!            9.0  !  04-03  (C. Ethe)  adpated for passive tracers
10   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
11   !!----------------------------------------------------------------------
12#if defined key_top && defined key_trcbbc
13   !!----------------------------------------------------------------------
14   !!   'key_trcbbc'                                  geothermal heat flux
15   !!----------------------------------------------------------------------
16   !!   trc_bbc      : update the tracer trend at ocean bottom
17   !!   trc_bbc_init : initialization of geothermal heat flux trend
18   !!----------------------------------------------------------------------
19   USE oce_trc             ! ocean dynamics and active tracers variables
20   USE trc                 ! ocean passive tracers variables
21   USE prtctl_trc          ! Print control for debbuging
22   USE trdmld_trc
23   USE trdmld_trc_oce     
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC trc_bbc          ! routine called by trcstp.F90
29
30   !! >>>>>>>>>>>>>>>>>>>>>>>>> MOVE TO NAMELIST >>>>>>>>>>>>>>>>>>>>>>>>>>
31   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .TRUE.   !: bbc flag
32   
33   INTEGER ::   ngeo_trc_flux = 1              !!! ** bbc namelist (nambbc) **
34   !                                           ! Geothermal flux (0:no flux, 1:constant flux,
35   !                                           !                  2:read in file )
36   REAL(wp) ::   ngeo_trc_flux_const = 86.4e-3 !!! ** bbc namlist **
37   !                                           ! Constant value of geothermal heat flux
38
39   INTEGER, DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt
40   REAL(wp), DIMENSION(jpi,jpj) ::   qgh_trd   ! geothermal heating trend
41   !! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
42
43   !! * Substitutions
44#  include "top_substitute.h90"
45   !!----------------------------------------------------------------------
46   !!  TOP 1.0 , LOCEAN-IPSL (2005)
47   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbc.F90,v 1.11 2006/09/12 11:10:13 opalod Exp $
48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
49   !!----------------------------------------------------------------------
50
51CONTAINS
52
53   SUBROUTINE trc_bbc( kt )
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE trc_bbc  ***
56      !!
57      !! ** Purpose :   Compute the bottom boundary contition on passive tracer
58      !!      associated with geothermal heating and add it to the general
59      !!      trend of tracers equations.
60      !!
61      !! ** Method  :   The geothermal heat flux set to its constant value of
62      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
63      !!       The temperature trend associated to this heat flux through the
64      !!       ocean bottom can be computed once and is added to the temperature
65      !!       trend juste above the bottom at each time step:
66      !!            tra = tra + Qsf / (rau0 rcp e3T) for k= mbathy -1
67      !!       Where Qsf is the geothermal heat flux.
68      !!
69      !! ** Action  : - update the temperature trends tra with the trend of
70      !!                the ocean bottom boundary condition
71      !!
72      !! References :
73      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
74      !!----------------------------------------------------------------------
75      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step index
76
77#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
78      INTEGER ::   ji, jn                                   ! dummy loop indices
79#else
80      INTEGER ::   ji, jj, jn                               ! dummy loop indices
81#endif
82      REAL(wp) ::   ztra                                    ! temporary scalar
83      CHARACTER (len=22) :: charout
84      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd   ! trends
85      !!----------------------------------------------------------------------
86
87      ! 0. Initialization
88      ! -----------------
89
90      IF( kt == nittrc000 )   CALL trc_bbc_init
91
92      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
93
94
95      ! 1. Add the geothermal heat flux trend on temperature
96      ! ----------------------------------------------------
97
98      SELECT CASE ( ngeo_trc_flux )
99
100      CASE ( 1:2 )                !  geothermal heat flux
101
102         !                                                       ! ===========
103         DO jn = 1, jptra                                        ! tracer loop
104            !                                                    ! ===========
105            IF( l_trdtrc )  ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
106
107
108#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
109            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
110               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1)
111            END DO
112#else
113            DO jj = 2, jpjm1
114               DO ji = 2, jpim1
115                  tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj)
116               END DO
117            END DO
118#endif
119           
120            IF( l_trdtrc ) THEN
121               ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
122               IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_bbc, kt)
123            END IF
124
125            !                                                    ! ===========
126         END DO                                                  ! tracer loop
127         !                                                       ! ===========
128
129         IF( l_trdtrc ) DEALLOCATE( ztrtrd )
130
131         IF( ln_ctl ) THEN     ! print mean trends (used for debugging)
132            WRITE(charout, FMT="('bbc')")
133            CALL prt_ctl_trc_info(charout)
134            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
135         ENDIF
136      END SELECT
137
138   END SUBROUTINE trc_bbc
139
140
141   SUBROUTINE trc_bbc_init
142      !!----------------------------------------------------------------------
143      !!                  ***  ROUTINE trc_bbc_init  ***
144      !!
145      !! ** Purpose :   Compute once for all the trend associated with geo-
146      !!      thermal heating that will be applied at each time step at the
147      !!      bottom ocean level
148      !!
149      !! ** Method  :   Read the namtopbbc namelist and check the parameters.
150      !!      called at the first time step (nittrc000)
151      !!
152      !! ** Input   : - Namlist namtopbbc
153      !!              - NetCDF file  : passivetrc_geothermal_heating.nc
154      !!                               ( if necessary )
155      !!
156      !! ** Action  : - compute the heat geothermal trend qgh_trd
157      !!              - compute the bottom ocean level nbotlevt
158      !!----------------------------------------------------------------------
159      USE iom
160
161      CHARACTER (len=32) ::   clname
162      INTEGER  ::   ji, jj              ! dummy loop indices
163      INTEGER  ::   inum = 11           ! temporary logical unit
164
165      NAMELIST/namtopbbc/ngeo_trc_flux, ngeo_trc_flux_const 
166      !!----------------------------------------------------------------------
167
168      ! Read Namelist nambbc : bottom momentum boundary condition
169      REWIND ( numnat )
170      READ   ( numnat, namtopbbc )
171
172      ! Control print
173      IF(lwp) WRITE(numout,*)
174      IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)'
175      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
176      IF(lwp) WRITE(numout,*) '          Namelist namtrcbbc : set bbc parameters'
177      IF(lwp) WRITE(numout,*)
178      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_trc_flux       = ', ngeo_trc_flux
179      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_trc_flux_const = ', ngeo_trc_flux_const
180      IF(lwp) WRITE(numout,*)
181
182      ! level of the ocean bottom at T-point
183
184      DO jj = 1, jpj
185         DO ji = 1, jpi
186            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
187         END DO
188      END DO
189
190      ! initialization of geothermal heat flux
191
192      SELECT CASE ( ngeo_trc_flux )
193
194      CASE ( 0 )                ! no geothermal heat flux
195         IF(lwp) WRITE(numout,*)
196         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
197
198      CASE ( 1 )                ! constant flux
199         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_trc_flux_const
200         qgh_trd(:,:) = ngeo_trc_flux_const
201
202      CASE ( 2 )                ! variable geothermal heat flux
203         ! read the geothermal fluxes in mW/m2
204         CALL iom_open ( 'geothermal_heating_trc.nc', inum )
205         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd )
206         CALL iom_close (inum)
207
208         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
209
210      CASE DEFAULT
211         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux
212         CALL ctl_stop( ctmp1 )
213
214      END SELECT
215
216      ! geothermal heat flux trend
217
218      SELECT CASE ( ngeo_trc_flux )
219
220      CASE ( 1:2 )                !  geothermal heat flux
221
222#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
223         DO ji = 1, jpij   ! vector opt. (forced unrolling)
224            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
225         END DO
226#else
227         DO jj = 1, jpj
228            DO ji = 1, jpi
229               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
230            END DO
231         END DO
232#endif
233
234      END SELECT
235
236   END SUBROUTINE trc_bbc_init
237
238#else
239   !!----------------------------------------------------------------------
240   !!   Default option                                         Empty module
241   !!----------------------------------------------------------------------
242   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .FALSE.  !: bbc flag
243CONTAINS
244   SUBROUTINE trc_bbc( kt )           ! Empty routine
245      INTEGER, INTENT(in) :: kt
246      WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt
247   END SUBROUTINE trc_bbc
248#endif
249
250   !!======================================================================
251END MODULE trcbbc
Note: See TracBrowser for help on using the repository browser.