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.
trdpen.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 8.2 KB
Line 
1MODULE trdpen
2   !!======================================================================
3   !!                       ***  MODULE  trdpen  ***
4   !! Ocean diagnostics:  Potential Energy trends
5   !!=====================================================================
6   !! History :  3.5  !  2012-02  (G. Madec) original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   trd_pen       : compute and output Potential Energy trends from T & S trends
11   !!   trd_pen_init  : initialisation of PE trends
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and tracers variables
14   USE dom_oce        ! ocean domain
15   USE sbc_oce        ! surface boundary condition: ocean
16   USE zdf_oce        ! ocean vertical physics
17   USE trd_oce        ! trends: ocean variables
18   USE eosbn2         ! equation of state and related derivatives
19   USE ldftra_oce     ! ocean active tracers lateral physics
20   USE zdfddm         ! vertical physics: double diffusion
21   USE phycst         ! physical constants
22   USE in_out_manager ! I/O manager
23   USE iom            ! I/O manager library
24   USE lib_mpp        ! MPP library
25   USE wrk_nemo       ! Memory allocation
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   trd_pen        ! called by all trdtra module
31   PUBLIC   trd_pen_init   ! called by all nemogcm module
32
33   INTEGER ::   nkstp   ! current time step
34
35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "zdfddm_substitute.h90"
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   INTEGER FUNCTION trd_pen_alloc()
49      !!---------------------------------------------------------------------
50      !!                  ***  FUNCTION trd_tra_alloc  ***
51      !!---------------------------------------------------------------------
52      ALLOCATE( rab_pe(jpi,jpj,jpk,jpts) , STAT= trd_pen_alloc )
53      !
54      IF( lk_mpp             )   CALL mpp_sum ( trd_pen_alloc )
55      IF( trd_pen_alloc /= 0 )   CALL ctl_warn( 'trd_pen_alloc: failed to allocate arrays' )
56   END FUNCTION trd_pen_alloc
57
58
59   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )
60      !!---------------------------------------------------------------------
61      !!                  ***  ROUTINE trd_tra_mng  ***
62      !!
63      !! ** Purpose :   Dispatch all trends computation, e.g. 3D output, integral
64      !!                constraints, barotropic vorticity, kinetic enrgy,
65      !!                potential energy, and/or mixed layer budget.
66      !!----------------------------------------------------------------------
67      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   ptrdx, ptrdy   ! Temperature & Salinity trends
68      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index
69      INTEGER                   , INTENT(in) ::   kt             ! time step index
70      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s]
71      !
72      INTEGER ::   jk                                            ! dummy loop indices
73      REAL(wp), POINTER, DIMENSION(:,:)      ::   z2d            ! 2D workspace
74      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zpe            ! 3D workspace
75      !!----------------------------------------------------------------------
76      !
77      CALL wrk_alloc( jpi, jpj, jpk, zpe )
78      zpe(:,:,:) = 0._wp
79      !
80      IF ( kt /= nkstp ) THEN   ! full eos: set partial derivatives at the 1st call of kt time step
81         nkstp = kt
82         CALL eos_pen( tsn, rab_PE, zpe )
83         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
84         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
85         CALL iom_put( "PEanom" , zpe )
86      ENDIF
87      !
88      zpe(:,:,jpk) = 0._wp
89      DO jk = 1, jpkm1
90         zpe(:,:,jk) = ( - ( rab_n(:,:,jk,jp_tem) + rab_pe(:,:,jk,jp_tem) ) * ptrdx(:,:,jk)   &
91            &            + ( rab_n(:,:,jk,jp_sal) + rab_pe(:,:,jk,jp_sal) ) * ptrdy(:,:,jk)  )
92      END DO
93
94      SELECT CASE ( ktrd )
95      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection
96      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
97      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
98                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
99                                   CALL wrk_alloc( jpi, jpj, z2d )
100                                   z2d(:,:) = wn(:,:,1) * ( &
101                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
102                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
103                                       &             ) / fse3t(:,:,1)
104                                   CALL iom_put( "petrd_sad" , z2d )
105                                   CALL wrk_dealloc( jpi, jpj, z2d )
106                                ENDIF
107      CASE ( jptra_ldf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion
108      CASE ( jptra_zdf  )   ;   CALL iom_put( "petrd_zdf" , zpe )   ! lateral  diffusion (K_z)
109      CASE ( jptra_zdfp )   ;   CALL iom_put( "petrd_zdfp", zpe )   ! vertical diffusion (K_z)
110      CASE ( jptra_dmp  )   ;   CALL iom_put( "petrd_dmp" , zpe )   ! internal 3D restoring (tradmp)
111      CASE ( jptra_bbl  )   ;   CALL iom_put( "petrd_bbl" , zpe )   ! bottom boundary layer
112      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment
113      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_nsr" , zpe )   ! surface forcing + runoff (ln_rnf=T)
114      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat
115      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
116      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
117                                !IF( .NOT.lk_vvl ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
118                                !   CALL wrk_alloc( jpi, jpj, z2d )
119                                !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
120                                !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
121                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt )
122                                !   CALL iom_put( "petrd_sad" , z2d )
123                                !   CALL wrk_dealloc( jpi, jpj, z2d )
124                                !ENDIF
125         !
126      END SELECT
127      !
128      CALL wrk_dealloc( jpi, jpj, jpk, zpe )
129      !
130   END SUBROUTINE trd_pen
131
132
133   SUBROUTINE trd_pen_init
134      !!---------------------------------------------------------------------
135      !!                  ***  ROUTINE trd_pen_init  ***
136      !!
137      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
138      !!----------------------------------------------------------------------
139      INTEGER  ::   ji, jj, jk   ! dummy loop indices
140      !!----------------------------------------------------------------------
141      !
142      IF(lwp) THEN
143         WRITE(numout,*)
144         WRITE(numout,*) 'trd_pen_init : 3D Potential ENergy trends'
145         WRITE(numout,*) '~~~~~~~~~~~~~'
146         IF(lflush) CALL flush(numout)
147      ENDIF
148      !                           ! allocate box volume arrays
149      IF ( trd_pen_alloc() /= 0 )   CALL ctl_stop('trd_pen_alloc: failed to allocate arrays')
150      !
151      rab_pe(:,:,:,:) = 0._wp
152      !
153!      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
154      !
155      nkstp     = nit000 - 1
156      !
157   END SUBROUTINE trd_pen_init
158
159   !!======================================================================
160END MODULE trdpen
Note: See TracBrowser for help on using the repository browser.