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 NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/TRA/trabbc.F90 @ 12109

Last change on this file since 12109 was 12109, checked in by cetlod, 4 years ago

check out & merge dev_r11643_ENHANCE-11_CEthe_Shaconemo_diags branch onto dev_r12072_TOP-01_ENHANCE-11_CEthe

  • Property svn:keywords set to Id
File size: 9.3 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   !
23   USE in_out_manager ! I/O manager
24   USE iom            ! xIOS
25   USE fldread        ! read input fields
26   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
27   USE lib_mpp        ! distributed memory computing library
28   USE prtctl         ! Print control
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/OCE 4.0 , NEMO Consortium (2018)
48   !! $Id$
49   !! Software governed by the CeCILL license (see ./LICENSE)
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 with geothermal heating trend
70      !!              - send the trend for further diagnostics (ln_trdtra=T)
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    ! dummy loop indices
78      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace
79      !!----------------------------------------------------------------------
80      !
81      IF( ln_timing )   CALL timing_start('tra_bbc')
82      !
83      IF( l_trdtra )   THEN         ! Save the input temperature trend
84         ALLOCATE( ztrdt(jpi,jpj,jpk) )
85         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
86      ENDIF
87      !                             !  Add the geothermal trend on temperature
88      DO jj = 2, jpjm1
89         DO ji = 2, jpim1
90            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))
91         END DO
92      END DO
93      !
94      CALL lbc_lnk( 'trabbc', tsa(:,:,:,jp_tem) , 'T', 1. )
95      !
96      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
97         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
98         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
99         DEALLOCATE( ztrdt )
100      ENDIF
101      !
102      CALL iom_put ( "hfgeou" , rau0_rcp * qgh_trd0(:,:) )
103      !
104      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
105      !
106      IF( ln_timing )   CALL timing_stop('tra_bbc')
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      INTEGER  ::   ji, jj              ! dummy loop indices
127      INTEGER  ::   inum                ! temporary logical unit
128      INTEGER  ::   ios                 ! Local integer output status for namelist read
129      INTEGER  ::   ierror              ! local integer
130      !
131      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
132      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
133      !!
134      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
135      !!----------------------------------------------------------------------
136      !
137      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
138      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
139901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
140      !
141      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
142      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
143902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
144      IF(lwm) WRITE ( numond, nambbc )
145      !
146      IF(lwp) THEN                     ! Control print
147         WRITE(numout,*)
148         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
149         WRITE(numout,*) '~~~~~~~   '
150         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
151         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
152         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
153         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
154         WRITE(numout,*)
155      ENDIF
156      !
157      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
158         !
159         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
160         !
161         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
162         !
163         CASE ( 1 )                          !* constant flux
164            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
165            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
166            !
167         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
168            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
169            !
170            ALLOCATE( sf_qgh(1), STAT=ierror )
171            IF( ierror > 0 ) THEN
172               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
173               RETURN
174            ENDIF
175            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
176            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
177            ! fill sf_chl with sn_chl and control print
178            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
179               &          'bottom temperature boundary condition', 'nambbc', no_print )
180
181            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
182            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
183            !
184         CASE DEFAULT
185            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
186            CALL ctl_stop( ctmp1 )
187         END SELECT
188         !
189      ELSE
190         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
191      ENDIF
192      !
193   END SUBROUTINE tra_bbc_init
194
195   !!======================================================================
196END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.