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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 2696

Last change on this file since 2696 was 2690, checked in by gm, 13 years ago

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