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/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 13191

Last change on this file since 13191 was 13191, checked in by jwhile, 4 years ago

Updates for 1d runnig
File size: 10.1 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   !!----------------------------------------------------------------------
[13191]14   !!   tra_bbc      : update the tracer trend at ocean bottom
[3]15   !!   tra_bbc_init : initialization of geothermal heat flux trend
16   !!----------------------------------------------------------------------
[2528]17   USE oce             ! ocean variables
18   USE dom_oce         ! domain: ocean
[3]19   USE phycst          ! physical constants
[4990]20   USE trd_oce         ! trends: ocean variables
[13191]21   USE trdtra          ! trends manager: tracers
[3]22   USE in_out_manager  ! I/O manager
[5397]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
[258]27   USE prtctl          ! Print control
[3294]28   USE wrk_nemo        ! Memory Allocation
29   USE timing          ! Timing
[11442]30   USE stopack
[3]31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC tra_bbc          ! routine called by step.F90
[2528]36   PUBLIC tra_bbc_init     ! routine called by opa.F90
[3]37
[4147]38   !                                 !!* Namelist nambbc: bottom boundary condition *
39   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
40   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
41   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
[3]42
[2528]43   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
[11442]44   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd1   ! geothermal heating trend
[5397]45   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
[13191]46
[3]47   !! * Substitutions
48#  include "domzgr_substitute.h90"
49   !!----------------------------------------------------------------------
[2528]50   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[5217]51   !! $Id$
[2528]52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]53   !!----------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE tra_bbc( kt )
57      !!----------------------------------------------------------------------
58      !!                  ***  ROUTINE tra_bbc  ***
59      !!
[13191]60      !! ** Purpose :   Compute the bottom boundary contition on temperature
61      !!              associated with geothermal heating and add it to the
[1601]62      !!              general trend of temperature equations.
[3]63      !!
[13191]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:
[2528]69      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
[3]70      !!       Where Qsf is the geothermal heat flux.
71      !!
72      !! ** Action  : - update the temperature trends (ta) with the trend of
73      !!                the ocean bottom boundary condition
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      !!----------------------------------------------------------------------
[2715]78      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[503]79      !!
[2528]80      INTEGER  ::   ji, jj, ik    ! dummy loop indices
81      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
[3294]82      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
[3]83      !!----------------------------------------------------------------------
[2528]84      !
[3294]85      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
86      !
[503]87      IF( l_trdtra )   THEN         ! Save ta and sa trends
[3294]88         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
89         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
[503]90      ENDIF
91      !
[2528]92      !                             !  Add the geothermal heat flux trend on temperature
[11442]93
[13191]94#if defined key_traldf_c2d || key_traldf_c3d
[11442]95      IF( ln_stopack .AND. nn_spp_geot > 0) THEN
96          qgh_trd1(:,:) = qgh_trd0(:,:)
97          CALL spp_gen(kt, qgh_trd1, nn_spp_geot, rn_geot_sd, jk_spp_geot)
98      ENDIF
[13191]99#else
100      IF ( ln_stopack .AND. nn_spp_geot > 0 ) &
101         & CALL ctl_stop( 'tra_bbc: parameter perturbation will only work with '// &
102                          'key_traldf_c2d or key_traldf_c3d')
103#endif
104
105
[2528]106      DO jj = 2, jpjm1
107         DO ji = 2, jpim1
108            ik = mbkt(ji,jj)
[11442]109            zqgh_trd = qgh_trd1(ji,jj) / fse3t(ji,jj,ik)
[2528]110            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
[3]111         END DO
[2528]112      END DO
113      !
[5397]114      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
115      !
[503]116      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
[2528]117         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
[4990]118         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
[3294]119         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
[3]120      ENDIF
[503]121      !
[2528]122      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
[503]123      !
[3294]124      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
125      !
[3]126   END SUBROUTINE tra_bbc
127
128
129   SUBROUTINE tra_bbc_init
130      !!----------------------------------------------------------------------
131      !!                  ***  ROUTINE tra_bbc_init  ***
132      !!
[1601]133      !! ** Purpose :   Compute once for all the trend associated with geothermal
134      !!              heating that will be applied at each time step at the
135      !!              last ocean level
[3]136      !!
137      !! ** Method  :   Read the nambbc namelist and check the parameters.
138      !!
139      !! ** Input   : - Namlist nambbc
140      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
141      !!
[592]142      !! ** Action  : - read/fix the geothermal heat qgh_trd0
[3]143      !!----------------------------------------------------------------------
[473]144      USE iom
[503]145      !!
[3]146      INTEGER  ::   ji, jj              ! dummy loop indices
[473]147      INTEGER  ::   inum                ! temporary logical unit
[4147]148      INTEGER  ::   ios                 ! Local integer output status for namelist read
[5397]149      INTEGER  ::   ierror              ! local integer
[4990]150      !
[5397]151      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
152      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
153      !
[13191]154      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir
[3]155      !!----------------------------------------------------------------------
156
[4147]157      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
158      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
159901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
[3]160
[4147]161      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
162      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
163902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
[4624]164      IF(lwm) WRITE ( numond, nambbc )
[4147]165
[2528]166      IF(lwp) THEN                     ! Control print
[1601]167         WRITE(numout,*)
[2528]168         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
[1601]169         WRITE(numout,*) '~~~~~~~   '
170         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
[2528]171         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
172         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
173         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
[1601]174         WRITE(numout,*)
175      ENDIF
[3]176
[2528]177      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
[503]178         !
[2528]179         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
[11442]180         ALLOCATE( qgh_trd1(jpi,jpj) )    ! allocation
[503]181         !
[2528]182         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
[503]183         !
[2528]184         CASE ( 1 )                          !* constant flux
185            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
[3625]186            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
[2528]187            !
188         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
189            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
190            !
[5397]191            ALLOCATE( sf_qgh(1), STAT=ierror )
192            IF( ierror > 0 ) THEN
193               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
194               RETURN
195            ENDIF
196            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
197            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
198            ! fill sf_chl with sn_chl and control print
199            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
200               &          'bottom temperature boundary condition', 'nambbc' )
201
202            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
203            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
204            !
[2528]205         CASE DEFAULT
206            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
207            CALL ctl_stop( ctmp1 )
208            !
209         END SELECT
[11442]210         qgh_trd1(:,:) = qgh_trd0(:,:)
[503]211         !
[2528]212      ELSE
213         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
214      ENDIF
[1601]215      !
[3]216   END SUBROUTINE tra_bbc_init
217
218   !!======================================================================
219END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.