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_r13383_HPC-02_Daley_Tiling/src/OCE/TRA – NEMO

source: NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbc.F90 @ 13518

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

Tiling for modules before tra_adv
  • Property svn:keywords set to Id
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   ! 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#  include "domzgr_substitute.h90"
51   !!----------------------------------------------------------------------
52   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
53   !! $Id$
54   !! Software governed by the CeCILL license (see ./LICENSE)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs )
59      !!----------------------------------------------------------------------
60      !!                  ***  ROUTINE tra_bbc  ***
61      !!
62      !! ** Purpose :   Compute the bottom boundary contition on temperature
63      !!              associated with geothermal heating and add it to the
64      !!              general trend of temperature equations.
65      !!
66      !! ** Method  :   The geothermal heat flux set to its constant value of
67      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
68      !!       The temperature trend associated to this heat flux through the
69      !!       ocean bottom can be computed once and is added to the temperature
70      !!       trend juste above the bottom at each time step:
71      !!            ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt
72      !!       Where Qsf is the geothermal heat flux.
73      !!
74      !! ** Action  : - update the temperature trends with geothermal heating trend
75      !!              - send the trend for further diagnostics (ln_trdtra=T)
76      !!
77      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
78      !!              Emile-Geay and Madec, 2009, Ocean Science.
79      !!----------------------------------------------------------------------
80      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
81      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
82      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
83      !
84      INTEGER  ::   ji, jj, jk    ! dummy loop indices
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 ST_2D(nn_hls) after trd_tra is tiled
94            ALLOCATE( ztrdt(jpi,jpj,jpk) )
95         ENDIF
96
97         DO_3D( 0, 0, 0, 0, 1, jpk )
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( 0, 0, 0, 0 )
103         pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs)   &
104            &             + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm)
105      END_2D
106      !
107      ! TEMP: These changes not necessary after trd_tra is tiled, lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes)
108      IF( l_trdtra ) THEN
109         DO_3D( 0, 0, 0, 0, 1, jpk )
110            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk)
111         END_3D
112      ENDIF
113
114      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
115         !
116         IF( l_trdtra ) THEN        ! Send the trend for diagnostics
117            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain
118
119            ! TODO: TO BE TILED- trd_tra
120            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt )
121            DEALLOCATE( ztrdt )
122
123            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain
124         ENDIF
125         !
126         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
127      ENDIF
128
129      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, &
130         &                                  clinfo3='tra-ta' )
131      !
132      IF( ln_timing )   CALL timing_stop('tra_bbc')
133      !
134   END SUBROUTINE tra_bbc
135
136
137   SUBROUTINE tra_bbc_init
138      !!----------------------------------------------------------------------
139      !!                  ***  ROUTINE tra_bbc_init  ***
140      !!
141      !! ** Purpose :   Compute once for all the trend associated with geothermal
142      !!              heating that will be applied at each time step at the
143      !!              last ocean level
144      !!
145      !! ** Method  :   Read the nambbc namelist and check the parameters.
146      !!
147      !! ** Input   : - Namlist nambbc
148      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
149      !!
150      !! ** Action  : - read/fix the geothermal heat qgh_trd0
151      !!----------------------------------------------------------------------
152      INTEGER  ::   ji, jj              ! dummy loop indices
153      INTEGER  ::   inum                ! temporary logical unit
154      INTEGER  ::   ios                 ! Local integer output status for namelist read
155      INTEGER  ::   ierror              ! local integer
156      !
157      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
158      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
159      !!
160      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
161      !!----------------------------------------------------------------------
162      !
163      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
164901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist' )
165      !
166      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
167902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist' )
168      IF(lwm) WRITE ( numond, nambbc )
169      !
170      IF(lwp) THEN                     ! Control print
171         WRITE(numout,*)
172         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
173         WRITE(numout,*) '~~~~~~~   '
174         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
175         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
176         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
177         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
178         WRITE(numout,*)
179      ENDIF
180      !
181      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
182         !
183         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
184         !
185         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
186         !
187         CASE ( 1 )                          !* constant flux
188            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst
189            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst
190            !
191         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
192            IF(lwp) WRITE(numout,*) '   ==>>>   variable geothermal heat flux'
193            !
194            ALLOCATE( sf_qgh(1), STAT=ierror )
195            IF( ierror > 0 ) THEN
196               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
197               RETURN
198            ENDIF
199            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
200            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
201            ! fill sf_chl with sn_chl and control print
202            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
203               &          'bottom temperature boundary condition', 'nambbc', no_print )
204
205            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
206            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
207            !
208         CASE DEFAULT
209            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
210            CALL ctl_stop( ctmp1 )
211         END SELECT
212         !
213      ELSE
214         IF(lwp) WRITE(numout,*) '   ==>>>   no geothermal heat flux'
215      ENDIF
216      !
217   END SUBROUTINE tra_bbc_init
218
219   !!======================================================================
220END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.