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.
trabbc.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMO/OPA_SRC/TRA/trabbc.F90 @ 247

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

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.6 KB
Line 
1MODULE trabbc
2   !!==============================================================================
3   !!                       ***  MODULE  trabbc  ***
4   !! Ocean active tracers:  bottom boundary condition
5   !!==============================================================================
6#if   defined key_trabbc   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_trabbc'                                  geothermal heat flux
9   !!----------------------------------------------------------------------
10   !!   tra_bbc      : update the tracer trend at ocean bottom
11   !!   tra_bbc_init : initialization of geothermal heat flux trend
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE oce             ! ocean dynamics and active tracers
15   USE dom_oce         ! ocean space and time domain
16   USE phycst          ! physical constants
17   USE in_out_manager  ! I/O manager
18
19   IMPLICIT NONE
20   PRIVATE
21
22   !! * Accessibility
23   PUBLIC tra_bbc          ! routine called by step.F90
24
25   !! to be transfert in the namelist ???!   
26   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag
27
28   !! * Module variables
29   INTEGER ::                       & !!! ** bbc namelist (nambbc) **
30      ngeo_flux = 1                    ! Geothermal flux (0:no flux, 1:constant flux,
31      !                                !                  2:read in file )
32   REAL(wp) ::                      & !!! ** bbc namlist **
33      ngeo_flux_const = 86.4e-3        ! Constant value of geothermal heat flux
34
35   INTEGER, DIMENSION(jpi,jpj) ::   &
36      nbotlevt                         ! ocean bottom level index at T-pt
37   REAL(wp), DIMENSION(jpi,jpj) ::  &
38      qgh_trd                          ! geothermal heating trend
39 
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !!  OPA 9.0 , LOCEAN-IPSL (2005)
44   !! $Header$
45   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE tra_bbc( kt )
51      !!----------------------------------------------------------------------
52      !!                  ***  ROUTINE tra_bbc  ***
53      !!
54      !! ** Purpose :   Compute the bottom boundary contition on temperature
55      !!      associated with geothermal heating and add it to the general
56      !!      trend of temperature equations.
57      !!
58      !! ** Method  :   The geothermal heat flux set to its constant value of
59      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
60      !!       The temperature trend associated to this heat flux through the
61      !!       ocean bottom can be computed once and is added to the temperature
62      !!       trend juste above the bottom at each time step:
63      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbathy -1
64      !!       Where Qsf is the geothermal heat flux.
65      !!
66      !! ** Action  : - update the temperature trends (ta) with the trend of
67      !!                the ocean bottom boundary condition
68      !!
69      !! References :
70      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
71      !!
72      !! History :
73      !!   8.1  !  99-10  (G. Madec)  original code
74      !!   8.5  !  02-08  (G. Madec)  free form + modules
75      !!----------------------------------------------------------------------
76      !! * Arguments
77      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
78
79      !! * Local declarations
80#if defined key_vectopt_loop   &&   ! defined key_autotasking
81      INTEGER ::   ji                  ! dummy loop indices
82#else
83      INTEGER ::   ji, jj              ! dummy loop indices
84#endif
85      REAL(wp) ::   zta                ! temporary scalar
86      !!----------------------------------------------------------------------
87
88      ! 0. Initialization
89      IF( kt == nit000 )   CALL tra_bbc_init
90
91      ! 1. Add the geothermal heat flux trend on temperature
92
93      SELECT CASE ( ngeo_flux )
94
95      CASE ( 1:2 )                !  geothermal heat flux
96
97#if defined key_vectopt_loop   &&   ! defined key_autotasking
98         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
99            ta(ji,1,nbotlevt(ji,1)) = ta(ji,1,nbotlevt(ji,1)) + qgh_trd(ji,1)
100         END DO
101#else
102         DO jj = 2, jpjm1
103            DO ji = 2, jpim1
104               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + qgh_trd(ji,jj)
105            END DO
106         END DO
107#endif
108
109      IF(l_ctl) THEN
110         zta = SUM( ta(2:nictl,2:njctl,1:jpkm1) * tmask(2:nictl,2:njctl,1:jpkm1) )
111         WRITE(numout,*) ' bbc  - Ta: ', zta-t_ctl
112         t_ctl = zta
113      ENDIF
114
115      END SELECT
116
117   END SUBROUTINE tra_bbc
118
119
120   SUBROUTINE tra_bbc_init
121      !!----------------------------------------------------------------------
122      !!                  ***  ROUTINE tra_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 nambbc namelist and check the parameters.
129      !!      called at the first time step (nit000)
130      !!
131      !! ** Input   : - Namlist nambbc
132      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
133      !!
134      !! ** Action  : - compute the heat geothermal trend qgh_trd
135      !!              - compute the bottom ocean level nbotlevt
136      !!
137      !! history :
138      !!  8.5  ! 02-11 (A. Bozec) original code
139      !!----------------------------------------------------------------------
140      !! * Modules used
141      USE ioipsl
142
143      !! * local declarations
144      CHARACTER (len=32) ::   clname
145      INTEGER  ::   ji, jj              ! dummy loop indices
146      INTEGER  ::   inum = 11           ! temporary logical unit
147      INTEGER  ::   itime               ! temporary integers
148      REAL(wp) ::   zdate0, zdt         ! temporary scalars
149      REAL(wp), DIMENSION(1) :: zdept   ! temporary workspace
150      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
151         zlamt, zphit, zdta   ! temporary workspace
152
153      NAMELIST/nambbc/ngeo_flux, ngeo_flux_const 
154      !!----------------------------------------------------------------------
155
156      ! Read Namelist nambbc : bottom momentum boundary condition
157      REWIND ( numnam )
158      READ   ( numnam, nambbc )
159
160      ! Control print
161      IF(lwp) WRITE(numout,*)
162      IF(lwp) WRITE(numout,*) 'tra_bbc : tempearture Bottom Boundary Condition (bbc)'
163      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
164      IF(lwp) WRITE(numout,*) '          Namelist nambbc : set bbc parameters'
165      IF(lwp) WRITE(numout,*)
166      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_flux       = ', ngeo_flux
167      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_flux_const = ', ngeo_flux_const
168      IF(lwp) WRITE(numout,*)
169
170      ! level of the ocean bottom at T-point
171
172      DO jj = 1, jpj
173         DO ji = 1, jpi
174            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
175         END DO
176      END DO
177
178      ! initialization of geothermal heat flux
179
180      SELECT CASE ( ngeo_flux )
181
182      CASE ( 0 )                ! no geothermal heat flux
183         IF(lwp) WRITE(numout,*)
184         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
185
186      CASE ( 1 )                ! constant flux
187         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_flux_const
188         qgh_trd(:,:) = ngeo_flux_const
189
190      CASE ( 2 )                ! variable geothermal heat flux
191         ! read the geothermal fluxes in mW/m2
192         clname = 'geothermal_heating'
193         itime = 1
194         zlamt(:,:) = 0.
195         zphit(:,:) = 0.
196         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux read in ', clname, ' file'
197         CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , clname,   &
198                       itime, zdate0, zdt, inum )
199         CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta )
200         DO jj = 1, nlcj
201            DO ji = 1, nlci
202              qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj))
203            END DO
204         END DO
205
206         CALL restclo( inum )
207         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
208
209      CASE DEFAULT
210         IF(lwp) WRITE(numout,cform_err)
211         IF(lwp) WRITE(numout,*) '     bad flag value for ngeo_flux = ', ngeo_flux
212         nstop = nstop + 1
213
214      END SELECT
215
216      ! geothermal heat flux trend
217
218      SELECT CASE ( ngeo_flux )
219
220      CASE ( 1:2 )                !  geothermal heat flux
221
222#if defined key_vectopt_loop   &&   ! defined key_autotasking
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 tra_bbc_init
237
238#else
239   !!----------------------------------------------------------------------
240   !!   Default option                                         Empty module
241   !!----------------------------------------------------------------------
242   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  !: bbc flag
243CONTAINS
244   SUBROUTINE tra_bbc( kt )           ! Empty routine
245      WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt
246   END SUBROUTINE tra_bbc
247#endif
248
249   !!======================================================================
250END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.