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

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

phasing the passive tracer transport module to the new version of NEMO, see ticket 143

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