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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 4401

Last change on this file since 4401 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

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