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/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 3625

Last change on this file since 3625 was 3625, checked in by acc, 11 years ago

Branch dev_NOC_2012_r3555. #1006. Step 7. Check in code now merged with dev_r3385_NOCS04_HAMF

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