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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 2325

Last change on this file since 2325 was 2325, checked in by cetlod, 14 years ago

Improvment of trabbc.F90 routine ( by gm ) : dynamical allocation + suppression of key_trabbc
  • Property svn:keywords set to Id
File size: 8.1 KB
Line 
1MODULE trabbc
2   !!==============================================================================
3   !!                       ***  MODULE  trabbc  ***
4   !! Ocean active tracers:  bottom boundary condition (geothermal heat flux)
5   !!==============================================================================
6   !! History :  OPA  ! 1999-10 (G. Madec)  original code
7   !!   NEMO     1.0  ! 2002-08 (G. Madec)  free form + modules
8   !!             -   ! 2002-11 (A. Bozec)  tra_bbc_init: original code
9   !!            3.3  ! 2010-10 (G. Madec)  dynamical allocation + suppression of key_trabbc
10   !!----------------------------------------------------------------------
11
12   !!   tra_bbc      : update the tracer trend at ocean bottom
13   !!   tra_bbc_init : initialization of geothermal heat flux trend
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and active tracers
16   USE dom_oce         ! ocean space and time domain
17   USE phycst          ! physical constants
18   USE trdmod_oce      ! ocean trends
19   USE trdtra      ! ocean trends
20   USE in_out_manager  ! I/O manager
21   USE prtctl          ! Print control
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC tra_bbc          ! routine called by step.F90
27   PUBLIC tra_bbc_init     ! routine called by opa.F90
28
29   !                                                !!* Namelist nambbc: bottom boundary condition *
30   LOGICAL, PUBLIC ::   ln_trabbc     = .FALSE.      !: Geothermal heat flux flag
31   INTEGER         ::   nn_geoflx     = 1            !  Geothermal flux (=1:constant flux, =2:read in file )
32   REAL(wp)        ::   rn_geoflx_cst = 86.4e-3_wp   !  Constant value of geothermal heat flux
33
34   INTEGER , DIMENSION(:,:), ALLOCATABLE ::   nbotlevt   ! ocean bottom level index at T-pt
35   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
36 
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
41   !! $Id $
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE tra_bbc( kt )
47      !!----------------------------------------------------------------------
48      !!                  ***  ROUTINE tra_bbc  ***
49      !!
50      !! ** Purpose :   Compute the bottom boundary contition on temperature
51      !!              associated with geothermal heating and add it to the
52      !!              general trend of temperature equations.
53      !!
54      !! ** Method  :   The geothermal heat flux set to its constant value of
55      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
56      !!       The temperature trend associated to this heat flux through the
57      !!       ocean bottom can be computed once and is added to the temperature
58      !!       trend juste above the bottom at each time step:
59      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbathy -1
60      !!       Where Qsf is the geothermal heat flux.
61      !!
62      !! ** Action  : - update the temperature trends (ta) with the trend of
63      !!                the ocean bottom boundary condition
64      !!
65      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
66      !!              Emile-Geay and Madec, 2009, Ocean Science.
67      !!----------------------------------------------------------------------
68      !!
69      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
70      !!
71      INTEGER  ::   ji, jj, ik    ! dummy loop indices
72      REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend
73      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt
74      !!----------------------------------------------------------------------
75
76      IF( l_trdtra )   THEN         ! Save ta and sa trends
77         ALLOCATE( ztrdt(jpi,jpj,jpk) )     ;   ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
78      ENDIF
79
80      !                             !  Add the geothermal heat flux trend on temperature
81#if defined key_vectopt_loop
82      DO jj = 1, 1
83         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
84#else
85      DO jj = 2, jpjm1
86         DO ji = 2, jpim1
87#endif
88            ik = nbotlevt(ji,jj)
89            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
90            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
91         END DO
92      END DO
93
94      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
95         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
96         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
97         DEALLOCATE( ztrdt )
98      ENDIF
99      !
100      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
101      !
102   END SUBROUTINE tra_bbc
103
104
105   SUBROUTINE tra_bbc_init
106      !!----------------------------------------------------------------------
107      !!                  ***  ROUTINE tra_bbc_init  ***
108      !!
109      !! ** Purpose :   Compute once for all the trend associated with geothermal
110      !!              heating that will be applied at each time step at the
111      !!              last ocean level
112      !!
113      !! ** Method  :   Read the nambbc namelist and check the parameters.
114      !!
115      !! ** Input   : - Namlist nambbc
116      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
117      !!
118      !! ** Action  : - read/fix the geothermal heat qgh_trd0
119      !!              - compute the bottom ocean level nbotlevt
120      !!----------------------------------------------------------------------
121      USE iom
122      !!
123      INTEGER  ::   ji, jj              ! dummy loop indices
124      INTEGER  ::   inum                ! temporary logical unit
125      !!
126      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
127      !!----------------------------------------------------------------------
128
129      REWIND ( numnam )              ! Read Namelist nambbc : bottom momentum boundary condition
130      READ   ( numnam, nambbc )
131
132      IF(lwp) THEN                     ! Control print
133         WRITE(numout,*)
134         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
135         WRITE(numout,*) '~~~~~~~   '
136         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
137         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
138         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
139         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
140         WRITE(numout,*)
141      ENDIF
142
143      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
144         !
145         ALLOCATE( nbotlevt(jpi,jpj) )    ! allocation
146         ALLOCATE( qgh_trd0(jpi,jpj) )     
147         !             
148         DO jj = 1, jpj                   ! level of the ocean bottom at T-point
149            DO ji = 1, jpi
150               nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
151            END DO
152         END DO
153         !
154         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
155         !
156         CASE ( 1 )                          !* constant flux
157            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
158            qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst
159            !
160         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
161            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
162            CALL iom_open ( 'geothermal_heating.nc', inum )
163            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
164            CALL iom_close( inum )
165            qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
166            !
167         CASE DEFAULT
168            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
169            CALL ctl_stop( ctmp1 )
170            !
171         END SELECT
172         !
173      ELSE
174            IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
175      ENDIF
176      !
177   END SUBROUTINE tra_bbc_init
178
179   !!======================================================================
180END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.