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

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

CT : UPDATE067 : Add control indices nictl, njctl used in SUM function output to compare mono versus multi procs runs

  • 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
107      IF(l_ctl) THEN
108         zta = SUM( ta(2:nictl,2:njctl,1:jpkm1) * tmask(2:nictl,2:njctl,1:jpkm1) )
109         WRITE(numout,*) ' bbc  - Ta: ', zta-t_ctl
110         t_ctl = zta
111      ENDIF
112
113      END SELECT
114
115   END SUBROUTINE tra_bbc
116
117
118   SUBROUTINE tra_bbc_init
119      !!----------------------------------------------------------------------
120      !!                  ***  ROUTINE tra_bbc_init  ***
121      !!
122      !! ** Purpose :   Compute once for all the trend associated with geo-
123      !!      thermal heating that will be applied at each time step at the
124      !!      bottom ocean level
125      !!
126      !! ** Method  :   Read the nambbc namelist and check the parameters.
127      !!      called at the first time step (nit000)
128      !!
129      !! ** Input   : - Namlist nambbc
130      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
131      !!
132      !! ** Action  : - compute the heat geothermal trend qgh_trd
133      !!              - compute the bottom ocean level nbotlevt
134      !!
135      !! history :
136      !!  8.5  ! 02-11 (A. Bozec) original code
137      !!----------------------------------------------------------------------
138      !! * Modules used
139      USE ioipsl
140
141      !! * local declarations
142      CHARACTER (len=32) ::   clname
143      INTEGER  ::   ji, jj              ! dummy loop indices
144      INTEGER  ::   inum = 11           ! temporary logical unit
145      INTEGER  ::   itime               ! temporary integers
146      REAL(wp) ::   zdate0, zdt         ! temporary scalars
147      REAL(wp), DIMENSION(1) :: zdept   ! temporary workspace
148      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
149         zlamt, zphit, zdta   ! temporary workspace
150
151      NAMELIST/nambbc/ngeo_flux, ngeo_flux_const 
152      !!----------------------------------------------------------------------
153
154      ! Read Namelist nambbc : bottom momentum boundary condition
155      REWIND ( numnam )
156      READ   ( numnam, nambbc )
157
158      ! Control print
159      IF(lwp) WRITE(numout,*)
160      IF(lwp) WRITE(numout,*) 'tra_bbc : tempearture Bottom Boundary Condition (bbc)'
161      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
162      IF(lwp) WRITE(numout,*) '          Namelist nambbc : set bbc parameters'
163      IF(lwp) WRITE(numout,*)
164      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_flux       = ', ngeo_flux
165      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_flux_const = ', ngeo_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_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_flux_const
186         qgh_trd(:,:) = ngeo_flux_const
187
188      CASE ( 2 )                ! variable geothermal heat flux
189         ! read the geothermal fluxes in mW/m2
190         clname = 'geothermal_heating'
191         itime = 1
192         zlamt(:,:) = 0.
193         zphit(:,:) = 0.
194         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux read in ', clname, ' file'
195         CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , clname,   &
196                       itime, zdate0, zdt, inum )
197         CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta )
198         DO jj = 1, nlcj
199            DO ji = 1, nlci
200              qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj))
201            END DO
202         END DO
203
204         CALL restclo( inum )
205         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
206
207      CASE DEFAULT
208         IF(lwp) WRITE(numout,cform_err)
209         IF(lwp) WRITE(numout,*) '     bad flag value for ngeo_flux = ', ngeo_flux
210         nstop = nstop + 1
211
212      END SELECT
213
214      ! geothermal heat flux trend
215
216      SELECT CASE ( ngeo_flux )
217
218      CASE ( 1:2 )                !  geothermal heat flux
219
220#if defined key_vectopt_loop   &&   ! defined key_autotasking
221         DO ji = 1, jpij   ! vector opt. (forced unrolling)
222            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
223         END DO
224#else
225         DO jj = 1, jpj
226            DO ji = 1, jpi
227               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
228            END DO
229         END DO
230#endif
231
232      END SELECT
233
234   END SUBROUTINE tra_bbc_init
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option                                         Empty module
239   !!----------------------------------------------------------------------
240   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  !: bbc flag
241CONTAINS
242   SUBROUTINE tra_bbc( kt )           ! Empty routine
243      WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt
244   END SUBROUTINE tra_bbc
245#endif
246
247   !!======================================================================
248END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.