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

Last change on this file since 340 was 334, checked in by opalod, 19 years ago

nemo_v1_update_022 : CE + RB + CT : add print control possibility

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 9.9 KB
Line 
1MODULE trcbbc
2   !!==============================================================================
3   !!                       ***  MODULE  trcbbc  ***
4   !! Ocean passive tracers:  bottom boundary condition
5   !!==============================================================================
6#if   defined key_passivetrc && defined key_trcbbc
7   !!----------------------------------------------------------------------
8   !!   'key_trcbbc'                                  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 "passivetrc_substitute.h90"
41   !!----------------------------------------------------------------------
42   !!  OPA 9.0 , LODYC-IPSL (2003)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE trc_bbc( kt )
48      !!----------------------------------------------------------------------
49      !!                  ***  ROUTINE trc_bbc  ***
50      !!
51      !! ** Purpose :   Compute the bottom boundary contition on passive tracer
52      !!      associated with geothermal heating and add it to the general
53      !!      trend of tracers equations.
54      !!
55      !! ** Method  :   The geothermal heat flux set to its constant value of
56      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
57      !!       The temperature trend associated to this heat flux through the
58      !!       ocean bottom can be computed once and is added to the temperature
59      !!       trend juste above the bottom at each time step:
60      !!            tra = tra + Qsf / (rau0 rcp e3T) for k= mbathy -1
61      !!       Where Qsf is the geothermal heat flux.
62      !!
63      !! ** Action  : - update the temperature trends tra with the trend of
64      !!                the ocean bottom boundary condition
65      !!
66      !! References :
67      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
68      !!
69      !! History :
70      !!   8.1  !  99-10  (G. Madec)  original code
71      !!   8.5  !  02-08  (G. Madec)  free form + modules
72      !!   9.0  !  04-03  (C. Ethe)  adpated for passive tracers
73      !!----------------------------------------------------------------------
74      !! * Arguments
75      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
76
77      !! * Local declarations
78#if defined key_vectopt_loop   &&   ! defined key_autotasking
79      INTEGER ::   ji, jn                  ! dummy loop indices
80#else
81      INTEGER ::   ji, jj, jn              ! dummy loop indices
82#endif
83      REAL(wp) ::   ztra                ! temporary scalar
84      CHARACTER (len=22) :: charout
85      !!----------------------------------------------------------------------
86
87      ! 0. Initialization
88      IF( kt == nittrc000 )   CALL trc_bbc_init
89
90      ! 1. Add the geothermal heat flux trend on temperature
91
92      SELECT CASE ( ngeo_trc_flux )
93
94      CASE ( 1:2 )                !  geothermal heat flux
95
96         DO jn = 1, jptra
97#if defined key_vectopt_loop   &&   ! defined key_autotasking
98            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
99               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1)
100            END DO
101#else
102            DO jj = 2, jpjm1
103               DO ji = 2, jpim1
104                  tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj)
105               END DO
106            END DO
107#endif
108         END DO
109
110         IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
111            WRITE(charout, FMT="('bbc')")
112            CALL prt_ctl_trc_info(charout)
113            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
114         ENDIF
115      END SELECT
116
117   END SUBROUTINE trc_bbc
118
119
120   SUBROUTINE trc_bbc_init
121      !!----------------------------------------------------------------------
122      !!                  ***  ROUTINE trc_bbc_init  ***
123      !!
124      !! ** Purpose :   Compute once for all the trend associated with geo-
125      !!      thermal heating that will be applied at each time step at the
126      !!      bottom ocean level
127      !!
128      !! ** Method  :   Read the namtrabbc namelist and check the parameters.
129      !!      called at the first time step (nittrc000)
130      !!
131      !! ** Input   : - Namlist namtrcbbc
132      !!              - NetCDF file  : passivetrc_geothermal_heating.nc
133      !!                               ( if necessary )
134      !!
135      !! ** Action  : - compute the heat geothermal trend qgh_trd
136      !!              - compute the bottom ocean level nbotlevt
137      !!
138      !! history :
139      !!  8.5  ! 02-11 (A. Bozec) original code
140      !!----------------------------------------------------------------------
141      !! * Modules used
142      USE ioipsl
143
144      !! * local declarations
145      CHARACTER (len=32) ::   clname
146      INTEGER  ::   ji, jj              ! dummy loop indices
147      INTEGER  ::   inum = 11           ! temporary logical unit
148      INTEGER  ::   itime               ! temporary integers
149      REAL(wp) ::   zdate0, zdt         ! temporary scalars
150      REAL(wp), DIMENSION(1) :: zdept   ! temporary workspace
151      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
152         zlamt, zphit, zdta   ! temporary workspace
153
154      NAMELIST/namtrcbbc/ngeo_trc_flux, ngeo_trc_flux_const 
155      !!----------------------------------------------------------------------
156
157      ! Read Namelist nambbc : bottom momentum boundary condition
158      REWIND ( numnamtra )
159      READ   ( numnamtra, namtrcbbc )
160
161      ! Control print
162      IF(lwp) WRITE(numout,*)
163      IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)'
164      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
165      IF(lwp) WRITE(numout,*) '          Namelist namtrcbbc : set bbc parameters'
166      IF(lwp) WRITE(numout,*)
167      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_trc_flux       = ', ngeo_trc_flux
168      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_trc_flux_const = ', ngeo_trc_flux_const
169      IF(lwp) WRITE(numout,*)
170
171      ! level of the ocean bottom at T-point
172
173      DO jj = 1, jpj
174         DO ji = 1, jpi
175            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
176         END DO
177      END DO
178
179      ! initialization of geothermal heat flux
180
181      SELECT CASE ( ngeo_trc_flux )
182
183      CASE ( 0 )                ! no geothermal heat flux
184         IF(lwp) WRITE(numout,*)
185         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
186
187      CASE ( 1 )                ! constant flux
188         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_trc_flux_const
189         qgh_trd(:,:) = ngeo_trc_flux_const
190
191      CASE ( 2 )                ! variable geothermal heat flux
192         ! read the geothermal fluxes in mW/m2
193         clname = 'passivetrc_geothermal_heating'
194         itime = 1
195         zlamt(:,:) = 0.
196         zphit(:,:) = 0.
197         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux read in ', clname, ' file'
198         CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , clname,   &
199                       itime, zdate0, zdt, inum )
200         CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta )
201         DO jj = 1, nlcj
202            DO ji = 1, nlci
203              qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj))
204            END DO
205         END DO
206
207         CALL restclo( inum )
208         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
209
210      CASE DEFAULT
211         IF(lwp) WRITE(numout,cform_err)
212         IF(lwp) WRITE(numout,*) '     bad flag value for ngeo_trc_flux = ', ngeo_trc_flux
213         nstop = nstop + 1
214
215      END SELECT
216
217      ! geothermal heat flux trend
218
219      SELECT CASE ( ngeo_trc_flux )
220
221      CASE ( 1:2 )                !  geothermal heat flux
222
223#if defined key_vectopt_loop   &&   ! defined key_autotasking
224         DO ji = 1, jpij   ! vector opt. (forced unrolling)
225            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
226         END DO
227#else
228         DO jj = 1, jpj
229            DO ji = 1, jpi
230               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
231            END DO
232         END DO
233#endif
234
235      END SELECT
236
237   END SUBROUTINE trc_bbc_init
238
239#else
240   !!----------------------------------------------------------------------
241   !!   Default option                                         Empty module
242   !!----------------------------------------------------------------------
243   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .FALSE.  !: bbc flag
244CONTAINS
245   SUBROUTINE trc_bbc( kt )           ! Empty routine
246      INTEGER, INTENT(in) :: kt
247      WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt
248   END SUBROUTINE trc_bbc
249#endif
250
251   !!======================================================================
252END MODULE trcbbc
Note: See TracBrowser for help on using the repository browser.