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/trunk/src/OCE/TRA – NEMO

source: NEMO/trunk/src/OCE/TRA/trabbc.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 5 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 9.4 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   !! * Substitutions
47#  include "do_loop_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs )
56      !!----------------------------------------------------------------------
57      !!                  ***  ROUTINE tra_bbc  ***
58      !!
59      !! ** Purpose :   Compute the bottom boundary contition on temperature
60      !!              associated with geothermal heating and add it to the
61      !!              general trend of temperature equations.
62      !!
63      !! ** Method  :   The geothermal heat flux set to its constant value of
64      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
65      !!       The temperature trend associated to this heat flux through the
66      !!       ocean bottom can be computed once and is added to the temperature
67      !!       trend juste above the bottom at each time step:
68      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
69      !!       Where Qsf is the geothermal heat flux.
70      !!
71      !! ** Action  : - update the temperature trends with geothermal heating trend
72      !!              - send the trend for further diagnostics (ln_trdtra=T)
73      !!
74      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
75      !!              Emile-Geay and Madec, 2009, Ocean Science.
76      !!----------------------------------------------------------------------
77      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
78      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
79      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
80      !
81      INTEGER  ::   ji, jj    ! dummy loop indices
82      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace
83      !!----------------------------------------------------------------------
84      !
85      IF( ln_timing )   CALL timing_start('tra_bbc')
86      !
87      IF( l_trdtra )   THEN         ! Save the input temperature trend
88         ALLOCATE( ztrdt(jpi,jpj,jpk) )
89         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
90      ENDIF
91      !                             !  Add the geothermal trend on temperature
92      DO_2D_00_00
93         pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm)
94      END_2D
95      !
96      CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. )
97      !
98      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
99         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
100         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
101         DEALLOCATE( ztrdt )
102      ENDIF
103      !
104      CALL iom_put ( "hfgeou" , rau0_rcp * qgh_trd0(:,:) )
105      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
106      !
107      IF( ln_timing )   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      INTEGER  ::   ji, jj              ! dummy loop indices
128      INTEGER  ::   inum                ! temporary logical unit
129      INTEGER  ::   ios                 ! Local integer output status for namelist read
130      INTEGER  ::   ierror              ! local integer
131      !
132      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
133      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
134      !!
135      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
136      !!----------------------------------------------------------------------
137      !
138      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
139901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
140      !
141      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
142902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
143      IF(lwm) WRITE ( numond, nambbc )
144      !
145      IF(lwp) THEN                     ! Control print
146         WRITE(numout,*)
147         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
148         WRITE(numout,*) '~~~~~~~   '
149         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
150         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
151         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
152         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
153         WRITE(numout,*)
154      ENDIF
155      !
156      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
157         !
158         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
159         !
160         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
161         !
162         CASE ( 1 )                          !* constant flux
163            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
164            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
165            !
166         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
167            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
168            !
169            ALLOCATE( sf_qgh(1), STAT=ierror )
170            IF( ierror > 0 ) THEN
171               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
172               RETURN
173            ENDIF
174            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
175            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
176            ! fill sf_chl with sn_chl and control print
177            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
178               &          'bottom temperature boundary condition', 'nambbc', no_print )
179
180            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
181            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
182            !
183         CASE DEFAULT
184            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
185            CALL ctl_stop( ctmp1 )
186         END SELECT
187         !
188      ELSE
189         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
190      ENDIF
191      !
192   END SUBROUTINE tra_bbc_init
193
194   !!======================================================================
195END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.