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

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

update transport modules to take into account new trends organization, see ticket:248
  • 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!CDIR COLLAPSE
106            IF( l_trdtrc )  ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
107
108
109#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
110            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
111               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1)
112            END DO
113#else
114            DO jj = 2, jpjm1
115               DO ji = 2, jpim1
116                  tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj)
117               END DO
118            END DO
119#endif
120           
121            IF( l_trdtrc ) THEN
122!CDIR COLLAPSE
123               ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
124               IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_bbc, kt)
125            END IF
126
127            !                                                    ! ===========
128         END DO                                                  ! tracer loop
129         !                                                       ! ===========
130
131         IF( l_trdtrc ) DEALLOCATE( ztrtrd )
132
133         IF( ln_ctl ) THEN     ! print mean trends (used for debugging)
134            WRITE(charout, FMT="('bbc')")
135            CALL prt_ctl_trc_info(charout)
136            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
137         ENDIF
138      END SELECT
139
140   END SUBROUTINE trc_bbc
141
142
143   SUBROUTINE trc_bbc_init
144      !!----------------------------------------------------------------------
145      !!                  ***  ROUTINE trc_bbc_init  ***
146      !!
147      !! ** Purpose :   Compute once for all the trend associated with geo-
148      !!      thermal heating that will be applied at each time step at the
149      !!      bottom ocean level
150      !!
151      !! ** Method  :   Read the namtopbbc namelist and check the parameters.
152      !!      called at the first time step (nittrc000)
153      !!
154      !! ** Input   : - Namlist namtopbbc
155      !!              - NetCDF file  : passivetrc_geothermal_heating.nc
156      !!                               ( if necessary )
157      !!
158      !! ** Action  : - compute the heat geothermal trend qgh_trd
159      !!              - compute the bottom ocean level nbotlevt
160      !!----------------------------------------------------------------------
161      USE iom
162
163      CHARACTER (len=32) ::   clname
164      INTEGER  ::   ji, jj              ! dummy loop indices
165      INTEGER  ::   inum = 11           ! temporary logical unit
166
167      NAMELIST/namtopbbc/ngeo_trc_flux, ngeo_trc_flux_const 
168      !!----------------------------------------------------------------------
169
170      ! Read Namelist nambbc : bottom momentum boundary condition
171      REWIND ( numnat )
172      READ   ( numnat, namtopbbc )
173
174      ! Control print
175      IF(lwp) WRITE(numout,*)
176      IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)'
177      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
178      IF(lwp) WRITE(numout,*) '          Namelist namtrcbbc : set bbc parameters'
179      IF(lwp) WRITE(numout,*)
180      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_trc_flux       = ', ngeo_trc_flux
181      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_trc_flux_const = ', ngeo_trc_flux_const
182      IF(lwp) WRITE(numout,*)
183
184      ! level of the ocean bottom at T-point
185
186      DO jj = 1, jpj
187         DO ji = 1, jpi
188            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
189         END DO
190      END DO
191
192      ! initialization of geothermal heat flux
193
194      SELECT CASE ( ngeo_trc_flux )
195
196      CASE ( 0 )                ! no geothermal heat flux
197         IF(lwp) WRITE(numout,*)
198         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
199
200      CASE ( 1 )                ! constant flux
201         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_trc_flux_const
202         qgh_trd(:,:) = ngeo_trc_flux_const
203
204      CASE ( 2 )                ! variable geothermal heat flux
205         ! read the geothermal fluxes in mW/m2
206         CALL iom_open ( 'geothermal_heating_trc.nc', inum )
207         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd )
208         CALL iom_close (inum)
209
210         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
211
212      CASE DEFAULT
213         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux
214         CALL ctl_stop( ctmp1 )
215
216      END SELECT
217
218      ! geothermal heat flux trend
219
220      SELECT CASE ( ngeo_trc_flux )
221
222      CASE ( 1:2 )                !  geothermal heat flux
223
224#if defined key_vectopt_loop   &&   ! defined key_mpp_omp
225         DO ji = 1, jpij   ! vector opt. (forced unrolling)
226            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
227         END DO
228#else
229         DO jj = 1, jpj
230            DO ji = 1, jpi
231               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
232            END DO
233         END DO
234#endif
235
236      END SELECT
237
238   END SUBROUTINE trc_bbc_init
239
240#else
241   !!----------------------------------------------------------------------
242   !!   Default option                                         Empty module
243   !!----------------------------------------------------------------------
244   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .FALSE.  !: bbc flag
245CONTAINS
246   SUBROUTINE trc_bbc( kt )           ! Empty routine
247      INTEGER, INTENT(in) :: kt
248      WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt
249   END SUBROUTINE trc_bbc
250#endif
251
252   !!======================================================================
253END MODULE trcbbc
Note: See TracBrowser for help on using the repository browser.