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

source: branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 9616

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

#2001: OMP directives
File size: 9.6 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   !!----------------------------------------------------------------------
14   !!   tra_bbc      : update the tracer trend at ocean bottom
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
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
[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
[2528]42   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
[5397]43   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
[3]44 
45   !! * Substitutions
46#  include "domzgr_substitute.h90"
47   !!----------------------------------------------------------------------
[2528]48   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[5217]49   !! $Id$
[2528]50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE tra_bbc( kt )
55      !!----------------------------------------------------------------------
56      !!                  ***  ROUTINE tra_bbc  ***
57      !!
58      !! ** Purpose :   Compute the bottom boundary contition on temperature
[1601]59      !!              associated with geothermal heating and add it to the
60      !!              general trend of temperature equations.
[3]61      !!
62      !! ** Method  :   The geothermal heat flux set to its constant value of
[1601]63      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
[3]64      !!       The temperature trend associated to this heat flux through the
65      !!       ocean bottom can be computed once and is added to the temperature
66      !!       trend juste above the bottom at each time step:
[2528]67      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
[3]68      !!       Where Qsf is the geothermal heat flux.
69      !!
70      !! ** Action  : - update the temperature trends (ta) with the trend of
71      !!                the ocean bottom boundary condition
72      !!
[503]73      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
[1601]74      !!              Emile-Geay and Madec, 2009, Ocean Science.
[503]75      !!----------------------------------------------------------------------
[2715]76      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[503]77      !!
[2528]78      INTEGER  ::   ji, jj, ik    ! dummy loop indices
79      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
[3294]80      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
[3]81      !!----------------------------------------------------------------------
[2528]82      !
[3294]83      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
84      !
[503]85      IF( l_trdtra )   THEN         ! Save ta and sa trends
[3294]86         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
87         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
[503]88      ENDIF
89      !
[2528]90      !                             !  Add the geothermal heat flux trend on temperature
[9176]91!$OMP PARALLEL DO PRIVATE(ik, zqgh_trd)
[2528]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
[3]97         END DO
[2528]98      END DO
99      !
[5397]100      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
101      !
[503]102      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
[2528]103         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
[4990]104         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
[3294]105         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
[3]106      ENDIF
[503]107      !
[2528]108      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
[503]109      !
[3294]110      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
111      !
[3]112   END SUBROUTINE tra_bbc
113
114
115   SUBROUTINE tra_bbc_init
116      !!----------------------------------------------------------------------
117      !!                  ***  ROUTINE tra_bbc_init  ***
118      !!
[1601]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
[3]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      !!
[592]128      !! ** Action  : - read/fix the geothermal heat qgh_trd0
[3]129      !!----------------------------------------------------------------------
[473]130      USE iom
[503]131      !!
[3]132      INTEGER  ::   ji, jj              ! dummy loop indices
[473]133      INTEGER  ::   inum                ! temporary logical unit
[4147]134      INTEGER  ::   ios                 ! Local integer output status for namelist read
[5397]135      INTEGER  ::   ierror              ! local integer
[4990]136      !
[5397]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 
[3]141      !!----------------------------------------------------------------------
142
[4147]143      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
144      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
145901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
[3]146
[4147]147      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
148      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
149902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
[4624]150      IF(lwm) WRITE ( numond, nambbc )
[4147]151
[2528]152      IF(lwp) THEN                     ! Control print
[1601]153         WRITE(numout,*)
[2528]154         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
[1601]155         WRITE(numout,*) '~~~~~~~   '
156         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
[2528]157         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
158         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
159         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
[1601]160         WRITE(numout,*)
161      ENDIF
[3]162
[2528]163      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
[503]164         !
[2528]165         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
[503]166         !
[2528]167         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
[503]168         !
[2528]169         CASE ( 1 )                          !* constant flux
170            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
[3625]171            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
[2528]172            !
173         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
174            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
175            !
[5397]176            ALLOCATE( sf_qgh(1), STAT=ierror )
177            IF( ierror > 0 ) THEN
178               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
179               RETURN
180            ENDIF
181            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
182            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
183            ! fill sf_chl with sn_chl and control print
184            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
185               &          'bottom temperature boundary condition', 'nambbc' )
186
187            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
188            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
189            !
[2528]190         CASE DEFAULT
191            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
192            CALL ctl_stop( ctmp1 )
193            !
194         END SELECT
[503]195         !
[2528]196      ELSE
197         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
198      ENDIF
[1601]199      !
[3]200   END SUBROUTINE tra_bbc_init
201
202   !!======================================================================
203END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.