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/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/trabbc.F90 @ 14286

Last change on this file since 14286 was 14219, checked in by mcastril, 3 years ago

Add Mixed Precision support by Oriol Tintó
  • Property svn:keywords set to Id
File size: 9.6 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#  include "domzgr_substitute.h90"
49#  include "single_precision_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
52   !! $Id$
53   !! Software governed by the CeCILL license (see ./LICENSE)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs )
58      !!----------------------------------------------------------------------
59      !!                  ***  ROUTINE tra_bbc  ***
60      !!
61      !! ** Purpose :   Compute the bottom boundary contition on temperature
62      !!              associated with geothermal heating and add it to the
63      !!              general trend of temperature equations.
64      !!
65      !! ** Method  :   The geothermal heat flux set to its constant value of
66      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
67      !!       The temperature trend associated to this heat flux through the
68      !!       ocean bottom can be computed once and is added to the temperature
69      !!       trend juste above the bottom at each time step:
70      !!            ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt
71      !!       Where Qsf is the geothermal heat flux.
72      !!
73      !! ** Action  : - update the temperature trends with geothermal heating trend
74      !!              - send the trend for further diagnostics (ln_trdtra=T)
75      !!
76      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
77      !!              Emile-Geay and Madec, 2009, Ocean Science.
78      !!----------------------------------------------------------------------
79      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
80      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
81      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
82      !
83      INTEGER  ::   ji, jj, jk    ! dummy loop indices
84      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace
85      !!----------------------------------------------------------------------
86      !
87      IF( ln_timing )   CALL timing_start('tra_bbc')
88      !
89      IF( l_trdtra ) THEN           ! Save the input temperature trend
90         ALLOCATE( ztrdt(jpi,jpj,jpk) )
91         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
92      ENDIF
93      !                             !  Add the geothermal trend on temperature
94      DO_2D( 0, 0, 0, 0 )
95         pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs)   &
96            &             + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm)
97      END_2D
98      !
99      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
100         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
101         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
102         DEALLOCATE( ztrdt )
103      ENDIF
104      !
105      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
106         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
107      ENDIF
108      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
109      !
110      IF( ln_timing )   CALL timing_stop('tra_bbc')
111      !
112   END SUBROUTINE tra_bbc
113
114
115   SUBROUTINE tra_bbc_init
116      !!----------------------------------------------------------------------
117      !!                  ***  ROUTINE tra_bbc_init  ***
118      !!
119      !! ** Purpose :   Compute once for all the trend associated with geothermal
120      !!              heating that will be applied at each time step at the
121      !!              last ocean level
122      !!
123      !! ** Method  :   Read the nambbc namelist and check the parameters.
124      !!
125      !! ** Input   : - Namlist nambbc
126      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
127      !!
128      !! ** Action  : - read/fix the geothermal heat qgh_trd0
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      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
142901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
143      !
144      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
145902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
146      IF(lwm) WRITE ( numond, nambbc )
147      !
148      IF(lwp) THEN                     ! Control print
149         WRITE(numout,*)
150         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
151         WRITE(numout,*) '~~~~~~~   '
152         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
153         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
154         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
155         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
156         WRITE(numout,*)
157      ENDIF
158      !
159      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
160         !
161         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
162         !
163         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
164         !
165         CASE ( 1 )                          !* constant flux
166            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
167            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst
168            !
169         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
170            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
171            !
172            ALLOCATE( sf_qgh(1), STAT=ierror )
173            IF( ierror > 0 ) THEN
174               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
175               RETURN
176            ENDIF
177            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
178            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
179            ! fill sf_chl with sn_chl and control print
180            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
181               &          'bottom temperature boundary condition', 'nambbc', no_print )
182
183            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
184            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
185            !
186         CASE DEFAULT
187            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
188            CALL ctl_stop( ctmp1 )
189         END SELECT
190         !
191      ELSE
192         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
193      ENDIF
194      !
195   END SUBROUTINE tra_bbc_init
196
197   !!======================================================================
198END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.