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

source: branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 5845

Last change on this file since 5845 was 5845, checked in by gm, 8 years ago

#1613: vvl by default: suppression of domzgr_substitute.h90

  • Property svn:keywords set to Id
File size: 9.5 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 trd_oce         ! trends: ocean variables
21   USE trdtra          ! trends manager: tracers
22   USE in_out_manager  ! I/O manager
23   USE iom             ! I/O manager
24   USE fldread         ! read input fields
25   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
26   USE lib_mpp           ! distributed memory computing library
27   USE prtctl          ! Print control
28   USE wrk_nemo        ! Memory Allocation
29   USE timing          ! Timing
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC tra_bbc          ! routine called by step.F90
35   PUBLIC tra_bbc_init     ! routine called by opa.F90
36
37   !                                 !!* Namelist nambbc: bottom boundary condition *
38   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
39   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
40   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
41
42   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
43
44   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
45 
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE tra_bbc( kt )
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_bbc  ***
56      !!
57      !! ** Purpose :   Compute the bottom boundary contition on temperature
58      !!              associated with geothermal heating and add it to the
59      !!              general trend of temperature equations.
60      !!
61      !! ** Method  :   The geothermal heat flux set to its constant value of
62      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
63      !!       The temperature trend associated to this heat flux through the
64      !!       ocean bottom can be computed once and is added to the temperature
65      !!       trend juste above the bottom at each time step:
66      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
67      !!       Where Qsf is the geothermal heat flux.
68      !!
69      !! ** Action  : - update the temperature trends (ta) with the trend of
70      !!                the ocean bottom boundary condition
71      !!
72      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
73      !!              Emile-Geay and Madec, 2009, Ocean Science.
74      !!----------------------------------------------------------------------
75      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
76      !!
77      INTEGER  ::   ji, jj, ik    ! dummy loop indices
78      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
79      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
80      !!----------------------------------------------------------------------
81      !
82      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
83      !
84      IF( l_trdtra )   THEN         ! Save ta and sa trends
85         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
86         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
87      ENDIF
88      !
89      !                             !  Add the geothermal heat flux trend on temperature
90      DO jj = 2, jpjm1
91         DO ji = 2, jpim1
92            ik = mbkt(ji,jj)
93            zqgh_trd = qgh_trd0(ji,jj) / e3t_n(ji,jj,ik)
94            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
95         END DO
96      END DO
97      !
98      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
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_bbc, ztrdt )
103         CALL wrk_dealloc( jpi, jpj, jpk, 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      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
109      !
110   END SUBROUTINE tra_bbc
111
112
113   SUBROUTINE tra_bbc_init
114      !!----------------------------------------------------------------------
115      !!                  ***  ROUTINE tra_bbc_init  ***
116      !!
117      !! ** Purpose :   Compute once for all the trend associated with geothermal
118      !!              heating that will be applied at each time step at the
119      !!              last ocean level
120      !!
121      !! ** Method  :   Read the nambbc namelist and check the parameters.
122      !!
123      !! ** Input   : - Namlist nambbc
124      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
125      !!
126      !! ** Action  : - read/fix the geothermal heat qgh_trd0
127      !!----------------------------------------------------------------------
128      USE iom
129      !!
130      INTEGER  ::   ji, jj              ! dummy loop indices
131      INTEGER  ::   inum                ! temporary logical unit
132      INTEGER  ::   ios                 ! Local integer output status for namelist read
133      INTEGER  ::   ierror              ! local integer
134      !
135      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
136      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
137      !
138      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
139      !!----------------------------------------------------------------------
140
141      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
142      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
143901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
144
145      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
146      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
147902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
148      IF(lwm) WRITE ( numond, nambbc )
149
150      IF(lwp) THEN                     ! Control print
151         WRITE(numout,*)
152         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
153         WRITE(numout,*) '~~~~~~~   '
154         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
155         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
156         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
157         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
158         WRITE(numout,*)
159      ENDIF
160
161      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
162         !
163         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
164         !
165         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
166         !
167         CASE ( 1 )                          !* constant flux
168            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
169            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
170            !
171         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
172            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
173            !
174            ALLOCATE( sf_qgh(1), STAT=ierror )
175            IF( ierror > 0 ) THEN
176               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
177               RETURN
178            ENDIF
179            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
180            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
181            ! fill sf_chl with sn_chl and control print
182            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
183               &          'bottom temperature boundary condition', 'nambbc' )
184
185            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
186            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
187            !
188         CASE DEFAULT
189            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
190            CALL ctl_stop( ctmp1 )
191            !
192         END SELECT
193         !
194      ELSE
195         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
196      ENDIF
197      !
198   END SUBROUTINE tra_bbc_init
199
200   !!======================================================================
201END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.