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/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90 @ 3329

Last change on this file since 3329 was 3329, checked in by gm, 12 years ago

Ediag branche: #927 add the missing trdpen initialisation in trdini

File size: 7.8 KB
Line 
1MODULE trdpen
2   !!======================================================================
3   !!                       ***  MODULE  trdpen  ***
4   !! Ocean diagnostics:  Potential ENnergy 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(:,:,:) ::   drau_dt, drau_ds   ! partial derivative of rau 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: trdtra.F90 3318 2012-02-25 15:50:01Z gm $
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( drau_dt(jpi,jpj,jpk) , drau_ds(jpi,jpj,jpk) , 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      !
79      IF ( nn_eos == 0 .AND.  kt /= nkstp ) THEN   ! full eos: set partial derivatives at the 1st call of kt time step
80         nkstp = kt
81         CALL eos_drau_dtds( tsn, drau_dt, drau_ds )
82      ENDIF
83      !
84      DO jk = 1, jpkm1
85         zpe(:,:,jk) = grav * fsde3w(:,:,jk) * (  drau_dt(:,:,jk) * ptrdx(:,:,jk)   &
86            &                                   + drau_ds(:,:,jk) * ptrdx(:,:,jk)  )
87      END DO
88
89      SELECT CASE ( ktrd )
90      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection
91      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
92      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
93                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
94                                   CALL wrk_alloc( jpi, jpj, z2d )
95                                   z2d(:,:) = wn(:,:,1) * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
96                                      &                     + drau_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / fse3t(:,:,1)
97                                   CALL iom_put( "petrd_sad" , z2d )
98                                   CALL wrk_dealloc( jpi, jpj, z2d )
99                                ENDIF
100      CASE ( jptra_ldf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion
101      CASE ( jptra_zdf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion (K_z)
102      CASE ( jptra_zdfp )   ;   CALL iom_put( "petrd_zdfp", zpe )   ! vertical diffusion (K_z)
103      CASE ( jptra_dmp  )   ;   CALL iom_put( "petrd_dmp" , zpe )   ! internal 3D restoring (tradmp)
104      CASE ( jptra_bbl  )   ;   CALL iom_put( "petrd_bbl" , zpe )   ! bottom boundary layer
105      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment
106      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_for" , zpe )   ! surface forcing + runoff (ln_rnf=T)
107      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat
108      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
109      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
110                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
111                                   CALL wrk_alloc( jpi, jpj, z2d )
112                                   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
113                                      &     * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
114                                      &         + drau_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt )
115                                   CALL iom_put( "petrd_sad" , z2d )
116                                   CALL wrk_dealloc( jpi, jpj, z2d )
117                                ENDIF
118      END SELECT
119      !
120      CALL wrk_dealloc( jpi, jpj, jpk, zpe )
121      !
122   END SUBROUTINE trd_pen
123
124
125   SUBROUTINE trd_pen_init
126      !!---------------------------------------------------------------------
127      !!                  ***  ROUTINE trd_pen_init  ***
128      !!
129      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
130      !!----------------------------------------------------------------------
131      INTEGER  ::   ji, jj, jk   ! dummy loop indices
132      !!----------------------------------------------------------------------
133      !
134      IF(lwp) THEN
135         WRITE(numout,*)
136         WRITE(numout,*) 'trd_pen_init : 3D Potential ENergy trends'
137         WRITE(numout,*) '~~~~~~~~~~~~~'
138      ENDIF
139      !                           ! allocate box volume arrays
140      IF ( trd_pen_alloc() /= 0 )   CALL ctl_stop('trd_pen_alloc: failed to allocate arrays')
141      !
142      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
143      !
144      nkstp     = nit000 - 1
145      !
146   END SUBROUTINE trd_pen_init
147
148   !!======================================================================
149END MODULE trdpen
Note: See TracBrowser for help on using the repository browser.