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

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 @ 4810

Last change on this file since 4810 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
  • Property svn:keywords set to Id
File size: 8.5 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
[2528]20   USE trdmod_oce      ! trends: ocean variables
21   USE trdtra          ! trends: active tracers
[3]22   USE in_out_manager  ! I/O manager
[258]23   USE prtctl          ! Print control
[3294]24   USE wrk_nemo        ! Memory Allocation
25   USE timing          ! Timing
[3]26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC tra_bbc          ! routine called by step.F90
[2528]31   PUBLIC tra_bbc_init     ! routine called by opa.F90
[3]32
[4147]33   !                                 !!* Namelist nambbc: bottom boundary condition *
34   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
35   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
36   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
[3]37
[2528]38   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
[3]39 
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
[2528]43   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
44   !! $Id $
45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE tra_bbc( kt )
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE tra_bbc  ***
52      !!
53      !! ** Purpose :   Compute the bottom boundary contition on temperature
[1601]54      !!              associated with geothermal heating and add it to the
55      !!              general trend of temperature equations.
[3]56      !!
57      !! ** Method  :   The geothermal heat flux set to its constant value of
[1601]58      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
[3]59      !!       The temperature trend associated to this heat flux through the
60      !!       ocean bottom can be computed once and is added to the temperature
61      !!       trend juste above the bottom at each time step:
[2528]62      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
[3]63      !!       Where Qsf is the geothermal heat flux.
64      !!
65      !! ** Action  : - update the temperature trends (ta) with the trend of
66      !!                the ocean bottom boundary condition
67      !!
[503]68      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
[1601]69      !!              Emile-Geay and Madec, 2009, Ocean Science.
[503]70      !!----------------------------------------------------------------------
[2715]71      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[503]72      !!
[2528]73      INTEGER  ::   ji, jj, ik    ! dummy loop indices
74      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
[3294]75      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
[3]76      !!----------------------------------------------------------------------
[2528]77      !
[3294]78      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
79      !
[503]80      IF( l_trdtra )   THEN         ! Save ta and sa trends
[3294]81         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
82         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
[503]83      ENDIF
84      !
[2528]85      !                             !  Add the geothermal heat flux trend on temperature
[789]86#if defined key_vectopt_loop
[2528]87      DO jj = 1, 1
88         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
[3]89#else
[2528]90      DO jj = 2, jpjm1
91         DO ji = 2, jpim1
[1601]92#endif
[2528]93            ik = mbkt(ji,jj)
94            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
95            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
[3]96         END DO
[2528]97      END DO
98      !
[503]99      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
[2528]100         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
101         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
[3294]102         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
[3]103      ENDIF
[503]104      !
[2528]105      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
[503]106      !
[3294]107      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
108      !
[3]109   END SUBROUTINE tra_bbc
110
111
112   SUBROUTINE tra_bbc_init
113      !!----------------------------------------------------------------------
114      !!                  ***  ROUTINE tra_bbc_init  ***
115      !!
[1601]116      !! ** Purpose :   Compute once for all the trend associated with geothermal
117      !!              heating that will be applied at each time step at the
118      !!              last ocean level
[3]119      !!
120      !! ** Method  :   Read the nambbc namelist and check the parameters.
121      !!
122      !! ** Input   : - Namlist nambbc
123      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
124      !!
[592]125      !! ** Action  : - read/fix the geothermal heat qgh_trd0
[3]126      !!----------------------------------------------------------------------
[473]127      USE iom
[503]128      !!
[3]129      INTEGER  ::   ji, jj              ! dummy loop indices
[473]130      INTEGER  ::   inum                ! temporary logical unit
[4147]131      INTEGER  ::   ios                 ! Local integer output status for namelist read
[1601]132      !!
[2528]133      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
[3]134      !!----------------------------------------------------------------------
135
[4147]136      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
137      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
138901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
[3]139
[4147]140      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
141      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
142902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
[4624]143      IF(lwm) WRITE ( numond, nambbc )
[4147]144
[2528]145      IF(lwp) THEN                     ! Control print
[1601]146         WRITE(numout,*)
[2528]147         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
[1601]148         WRITE(numout,*) '~~~~~~~   '
149         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
[2528]150         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
151         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
152         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
[1601]153         WRITE(numout,*)
154      ENDIF
[3]155
[2528]156      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
[503]157         !
[2528]158         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
[503]159         !
[2528]160         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
[503]161         !
[2528]162         CASE ( 1 )                          !* constant flux
163            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
[3625]164            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst
[2528]165            !
166         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
167            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
168            CALL iom_open ( 'geothermal_heating.nc', inum )
169            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
170            CALL iom_close( inum )
[3625]171            qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
[2528]172            !
173         CASE DEFAULT
174            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
175            CALL ctl_stop( ctmp1 )
176            !
177         END SELECT
[503]178         !
[2528]179      ELSE
180         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
181      ENDIF
[1601]182      !
[3]183   END SUBROUTINE tra_bbc_init
184
185   !!======================================================================
186END MODULE trabbc
Note: See TracBrowser for help on using the repository browser.