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

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago

#2050 fixes and changes
File size: 10.5 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   USE in_out_manager  ! I/O manager
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
27   USE prtctl          ! Print control
28   USE wrk_nemo        ! Memory Allocation
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   PRIVATE bbc_namelist
37
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
42
43   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
44   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
45 
46   !! * Substitutions
47#  include "domzgr_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE tra_bbc( kt )
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 (ta) with the trend of
72      !!                the ocean bottom boundary condition
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      !!
79      INTEGER  ::   ji, jj, ik    ! dummy loop indices
80      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
81      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
82      !!----------------------------------------------------------------------
83      !
84      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
85      !
86      IF( l_trdtra )   THEN         ! Save ta and sa trends
87         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
88         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
89      ENDIF
90      !
91      !                             !  Add the geothermal heat flux trend on temperature
92      DO jj = 2, jpjm1
93         DO ji = 2, jpim1
94            ik = mbkt(ji,jj)
95            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
96            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
97         END DO
98      END DO
99      !
100      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
101      !
102      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
103         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
104         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
105         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
106      ENDIF
107      !
108      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
109      !
110      IF( nn_timing == 1 )  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      USE iom
131      !!
132      INTEGER  ::   ji, jj              ! dummy loop indices
133      INTEGER  ::   inum                ! temporary logical unit
134      INTEGER  ::   ios                 ! Local integer output status for namelist read
135      INTEGER  ::   ierror              ! local integer
136      !
137      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
138      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
139      !
140      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
141      !!----------------------------------------------------------------------
142      IF(lwm) THEN
143         REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
144         READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
145901      CONTINUE
146      ENDIF
147      call mpp_bcast(ios)
148      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
149      IF(lwm) THEN
150         REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
151         READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
152902      CONTINUE
153      ENDIF
154      call mpp_bcast(ios)
155      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
156      IF(lwm) WRITE ( numond, nambbc )
157
158      call bbc_namelist(sn_qgh, cn_dir)
159
160      IF(lwp) THEN                     ! Control print
161         WRITE(numout,*)
162         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
163         WRITE(numout,*) '~~~~~~~   '
164         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
165         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
166         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
167         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
168         WRITE(numout,*)
169      ENDIF
170
171      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
172         !
173         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
174         !
175         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
176         !
177         CASE ( 1 )                          !* constant flux
178            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
179            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
180            !
181         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
182            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
183            !
184            ALLOCATE( sf_qgh(1), STAT=ierror )
185            IF( ierror > 0 ) THEN
186               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
187               RETURN
188            ENDIF
189            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
190            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
191            ! fill sf_chl with sn_chl and control print
192            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
193               &          'bottom temperature boundary condition', 'nambbc' )
194
195            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
196            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
197            !
198         CASE DEFAULT
199            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
200            CALL ctl_stop( ctmp1 )
201            !
202         END SELECT
203         !
204      ELSE
205         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
206      ENDIF
207      !
208   END SUBROUTINE tra_bbc_init
209
210   SUBROUTINE bbc_namelist(sd_qgh, cd_dir)
211     !!---------------------------------------------------------------------
212     !!                   ***  ROUTINE bbc_namelist  ***
213     !!                     
214     !! ** Purpose :   Broadcast namelist variables read by procesor lwm
215     !!
216     !! ** Method  :   use lib_mpp
217     !!----------------------------------------------------------------------
218      TYPE(FLD_N)        ::   sd_qgh    ! informations about the geotherm. field to be read
219      CHARACTER(len=256) ::   cd_dir    ! Root directory for location of ssr files
220
221#if defined key_mpp_mpi
222      CALL mpp_bcast(ln_trabbc)
223      CALL mpp_bcast(nn_geoflx)
224      CALL mpp_bcast(rn_geoflx_cst)
225      CALL fld_n_bcast(sd_qgh)
226      CALL mpp_bcast(cd_dir, 256)
227#endif
228   END SUBROUTINE bbc_namelist
229
230   !!======================================================================
231END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.