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/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/TRA – NEMO

source: NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/TRA/trabbc.F90 @ 13409

Last change on this file since 13409 was 13409, checked in by hadcv, 4 years ago

Remaining changes prior to trunk merge
  • Property svn:keywords set to Id
File size: 10.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   ! TEMP: This change not necessary after trd_tra is tiled
20   USE domain, ONLY : dom_tile
21   USE phycst         ! physical constants
22   USE trd_oce        ! trends: ocean variables
23   USE trdtra         ! trends manager: tracers
24   !
25   USE in_out_manager ! I/O manager
26   USE iom            ! xIOS
27   USE fldread        ! read input fields
28   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
29   USE lib_mpp        ! distributed memory computing library
30   USE prtctl         ! Print control
31   USE timing         ! Timing
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC tra_bbc          ! routine called by step.F90
37   PUBLIC tra_bbc_init     ! routine called by opa.F90
38
39   !                                 !!* Namelist nambbc: bottom boundary condition *
40   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
41   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
42   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
43
44   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
45
46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
47 
48   !! * Substitutions
49#  include "do_loop_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(wp), 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), SAVE :: zsum1
85      ! TEMP: This change not necessary after trd_tra is tiled
86      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace
87      !!----------------------------------------------------------------------
88      !
89      IF( ln_timing )   CALL timing_start('tra_bbc')
90      !
91      IF( l_trdtra ) THEN           ! Save the input temperature trend
92         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
93            ! TEMP: This can be A2D after trd_tra is tiled
94            ALLOCATE( ztrdt(jpi,jpj,jpk) )
95         ENDIF
96
97         DO_3D_00_00( 1, jpkm1 )
98            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs)
99         END_3D
100      ENDIF
101      !                             !  Add the geothermal trend on temperature
102      DO_2D_00_00
103         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)
104      END_2D
105      !
106      ! TEMP: These changes not necessary after trd_tra is tiled, lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes)
107      IF( l_trdtra ) THEN
108         DO_3D_00_00( 1, jpkm1 )
109            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk)
110         END_3D
111      ENDIF
112
113      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
114         ! NOTE: I don't think pts needs to be the input here?
115         CALL lbc_lnk( 'trabbc', ztrdt(:,:,:) , 'T', 1. )
116         !
117         IF( l_trdtra ) THEN        ! Send the trend for diagnostics
118            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain
119
120            ! TODO: TO BE TILED- trd_tra
121            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
122            DEALLOCATE( ztrdt )
123
124            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain
125         ENDIF
126         !
127         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
128      ENDIF
129
130      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, psum1=zsum1, &
131         &                                  clinfo3='tra-ta' )
132      !
133      IF( ln_timing )   CALL timing_stop('tra_bbc')
134      !
135   END SUBROUTINE tra_bbc
136
137
138   SUBROUTINE tra_bbc_init
139      !!----------------------------------------------------------------------
140      !!                  ***  ROUTINE tra_bbc_init  ***
141      !!
142      !! ** Purpose :   Compute once for all the trend associated with geothermal
143      !!              heating that will be applied at each time step at the
144      !!              last ocean level
145      !!
146      !! ** Method  :   Read the nambbc namelist and check the parameters.
147      !!
148      !! ** Input   : - Namlist nambbc
149      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
150      !!
151      !! ** Action  : - read/fix the geothermal heat qgh_trd0
152      !!----------------------------------------------------------------------
153      INTEGER  ::   ji, jj              ! dummy loop indices
154      INTEGER  ::   inum                ! temporary logical unit
155      INTEGER  ::   ios                 ! Local integer output status for namelist read
156      INTEGER  ::   ierror              ! local integer
157      !
158      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
159      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
160      !!
161      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
162      !!----------------------------------------------------------------------
163      !
164      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
165901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
166      !
167      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
168902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
169      IF(lwm) WRITE ( numond, nambbc )
170      !
171      IF(lwp) THEN                     ! Control print
172         WRITE(numout,*)
173         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
174         WRITE(numout,*) '~~~~~~~   '
175         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
176         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
177         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
178         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
179         WRITE(numout,*)
180      ENDIF
181      !
182      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
183         !
184         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
185         !
186         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
187         !
188         CASE ( 1 )                          !* constant flux
189            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
190            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst
191            !
192         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
193            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
194            !
195            ALLOCATE( sf_qgh(1), STAT=ierror )
196            IF( ierror > 0 ) THEN
197               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
198               RETURN
199            ENDIF
200            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
201            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
202            ! fill sf_chl with sn_chl and control print
203            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
204               &          'bottom temperature boundary condition', 'nambbc', no_print )
205
206            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
207            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
208            !
209         CASE DEFAULT
210            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
211            CALL ctl_stop( ctmp1 )
212         END SELECT
213         !
214      ELSE
215         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
216      ENDIF
217      !
218   END SUBROUTINE tra_bbc_init
219
220   !!======================================================================
221END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.