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

Last change on this file since 64 was 32, checked in by opalod, 20 years ago

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