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

Last change on this file since 13237 was 13237, checked in by smasson, 4 months ago

trunk: Mid-year merge, merge back KERNEL-06_techene_e3

  • Property svn:keywords set to Id
File size: 9.5 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   !!----------------------------------------------------------------------
[6140]14   !!   tra_bbc       : update the tracer trend at ocean bottom
15   !!   tra_bbc_init  : initialization of geothermal heat flux trend
[3]16   !!----------------------------------------------------------------------
[6140]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
[3]30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC tra_bbc          ! routine called by step.F90
[2528]35   PUBLIC tra_bbc_init     ! routine called by opa.F90
[3]36
[4147]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
[3]41
[6140]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)
[3]45 
[12377]46   !! * Substitutions
47#  include "do_loop_substitute.h90"
[13237]48#  include "domzgr_substitute.h90"
[3]49   !!----------------------------------------------------------------------
[9598]50   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5217]51   !! $Id$
[10068]52   !! Software governed by the CeCILL license (see ./LICENSE)
[3]53   !!----------------------------------------------------------------------
54CONTAINS
55
[12377]56   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs )
[3]57      !!----------------------------------------------------------------------
58      !!                  ***  ROUTINE tra_bbc  ***
59      !!
60      !! ** Purpose :   Compute the bottom boundary contition on temperature
[1601]61      !!              associated with geothermal heating and add it to the
62      !!              general trend of temperature equations.
[3]63      !!
64      !! ** Method  :   The geothermal heat flux set to its constant value of
[1601]65      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
[3]66      !!       The temperature trend associated to this heat flux through the
67      !!       ocean bottom can be computed once and is added to the temperature
68      !!       trend juste above the bottom at each time step:
[12489]69      !!            ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt
[3]70      !!       Where Qsf is the geothermal heat flux.
71      !!
[6140]72      !! ** Action  : - update the temperature trends with geothermal heating trend
73      !!              - send the trend for further diagnostics (ln_trdtra=T)
[3]74      !!
[503]75      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
[1601]76      !!              Emile-Geay and Madec, 2009, Ocean Science.
[503]77      !!----------------------------------------------------------------------
[12377]78      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
79      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
80      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
[6140]81      !
[7753]82      INTEGER  ::   ji, jj    ! dummy loop indices
[9019]83      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace
[3]84      !!----------------------------------------------------------------------
[2528]85      !
[9019]86      IF( ln_timing )   CALL timing_start('tra_bbc')
[3294]87      !
[6140]88      IF( l_trdtra )   THEN         ! Save the input temperature trend
[9019]89         ALLOCATE( ztrdt(jpi,jpj,jpk) )
[12377]90         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
[503]91      ENDIF
[6140]92      !                             !  Add the geothermal trend on temperature
[12377]93      DO_2D_00_00
[13237]94         pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs)   &
95            &             + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm)
[12377]96      END_2D
[2528]97      !
[13226]98      CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1.0_wp )
[5397]99      !
[6140]100      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
[12377]101         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
102         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
[9019]103         DEALLOCATE( ztrdt )
[3]104      ENDIF
[503]105      !
[12489]106      CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
[12377]107      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
[12276]108      !
[9019]109      IF( ln_timing )   CALL timing_stop('tra_bbc')
[3294]110      !
[3]111   END SUBROUTINE tra_bbc
112
113
114   SUBROUTINE tra_bbc_init
115      !!----------------------------------------------------------------------
116      !!                  ***  ROUTINE tra_bbc_init  ***
117      !!
[1601]118      !! ** Purpose :   Compute once for all the trend associated with geothermal
119      !!              heating that will be applied at each time step at the
120      !!              last ocean level
[3]121      !!
122      !! ** Method  :   Read the nambbc namelist and check the parameters.
123      !!
124      !! ** Input   : - Namlist nambbc
125      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
126      !!
[592]127      !! ** Action  : - read/fix the geothermal heat qgh_trd0
[3]128      !!----------------------------------------------------------------------
129      INTEGER  ::   ji, jj              ! dummy loop indices
[473]130      INTEGER  ::   inum                ! temporary logical unit
[4147]131      INTEGER  ::   ios                 ! Local integer output status for namelist read
[5397]132      INTEGER  ::   ierror              ! local integer
[4990]133      !
[5397]134      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
135      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
[9019]136      !!
[5397]137      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
[3]138      !!----------------------------------------------------------------------
[6140]139      !
[4147]140      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
[11536]141901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
[6140]142      !
[4147]143      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
[11536]144902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
[4624]145      IF(lwm) WRITE ( numond, nambbc )
[6140]146      !
[2528]147      IF(lwp) THEN                     ! Control print
[1601]148         WRITE(numout,*)
[2528]149         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
[1601]150         WRITE(numout,*) '~~~~~~~   '
151         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
[2528]152         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
153         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
154         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
[1601]155         WRITE(numout,*)
156      ENDIF
[6140]157      !
[2528]158      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
[503]159         !
[2528]160         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
[503]161         !
[2528]162         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
[503]163         !
[2528]164         CASE ( 1 )                          !* constant flux
[9190]165            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
[12489]166            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst
[2528]167            !
168         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
[9190]169            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
[2528]170            !
[5397]171            ALLOCATE( sf_qgh(1), STAT=ierror )
172            IF( ierror > 0 ) THEN
173               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
174               RETURN
175            ENDIF
176            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
[9019]177            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
[5397]178            ! fill sf_chl with sn_chl and control print
179            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
[7646]180               &          'bottom temperature boundary condition', 'nambbc', no_print )
[5397]181
182            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
[12489]183            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
[5397]184            !
[2528]185         CASE DEFAULT
186            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
187            CALL ctl_stop( ctmp1 )
188         END SELECT
[503]189         !
[2528]190      ELSE
[9190]191         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
[2528]192      ENDIF
[1601]193      !
[3]194   END SUBROUTINE tra_bbc_init
195
196   !!======================================================================
197END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.