source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 18 months ago

The Dr Hook changes from my perl code.

File size: 9.3 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   USE yomhook, ONLY: lhook, dr_hook
28   USE parkind1, ONLY: jprb, jpim
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   trd_pen        ! called by all trdtra module
34   PUBLIC   trd_pen_init   ! called by all nemogcm module
35
36   INTEGER ::   nkstp   ! current time step
37
38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42#  include "zdfddm_substitute.h90"
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   INTEGER FUNCTION trd_pen_alloc()
52   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
53   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
54   REAL(KIND=jprb)               :: zhook_handle
55
56   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_PEN_ALLOC'
57
58   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
59
60      !!---------------------------------------------------------------------
61      !!                  ***  FUNCTION trd_tra_alloc  ***
62      !!---------------------------------------------------------------------
63      ALLOCATE( rab_pe(jpi,jpj,jpk,jpts) , STAT= trd_pen_alloc )
64      !
65      IF( lk_mpp             )   CALL mpp_sum ( trd_pen_alloc )
66      IF( trd_pen_alloc /= 0 )   CALL ctl_warn( 'trd_pen_alloc: failed to allocate arrays' )
67   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
68   END FUNCTION trd_pen_alloc
69
70
71   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )
72      !!---------------------------------------------------------------------
73      !!                  ***  ROUTINE trd_tra_mng  ***
74      !!
75      !! ** Purpose :   Dispatch all trends computation, e.g. 3D output, integral
76      !!                constraints, barotropic vorticity, kinetic enrgy,
77      !!                potential energy, and/or mixed layer budget.
78      !!----------------------------------------------------------------------
79      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   ptrdx, ptrdy   ! Temperature & Salinity trends
80      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index
81      INTEGER                   , INTENT(in) ::   kt             ! time step index
82      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s]
83      !
84      INTEGER ::   jk                                            ! dummy loop indices
85      REAL(wp), POINTER, DIMENSION(:,:)      ::   z2d            ! 2D workspace
86      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zpe            ! 3D workspace
87      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
88      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
89      REAL(KIND=jprb)               :: zhook_handle
90
91      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_PEN'
92
93      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
94
95      !!----------------------------------------------------------------------
96      !
97      CALL wrk_alloc( jpi, jpj, jpk, zpe )
98      zpe(:,:,:) = 0._wp
99      !
100      IF ( kt /= nkstp ) THEN   ! full eos: set partial derivatives at the 1st call of kt time step
101         nkstp = kt
102         CALL eos_pen( tsn, rab_PE, zpe )
103         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
104         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
105         CALL iom_put( "PEanom" , zpe )
106      ENDIF
107      !
108      zpe(:,:,jpk) = 0._wp
109      DO jk = 1, jpkm1
110         zpe(:,:,jk) = ( - ( rab_n(:,:,jk,jp_tem) + rab_pe(:,:,jk,jp_tem) ) * ptrdx(:,:,jk)   &
111            &            + ( rab_n(:,:,jk,jp_sal) + rab_pe(:,:,jk,jp_sal) ) * ptrdy(:,:,jk)  )
112      END DO
113
114      SELECT CASE ( ktrd )
115      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection
116      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
117      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
118                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
119                                   CALL wrk_alloc( jpi, jpj, z2d )
120                                   z2d(:,:) = wn(:,:,1) * ( &
121                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
122                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
123                                       &             ) / fse3t(:,:,1)
124                                   CALL iom_put( "petrd_sad" , z2d )
125                                   CALL wrk_dealloc( jpi, jpj, z2d )
126                                ENDIF
127      CASE ( jptra_ldf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion
128      CASE ( jptra_zdf  )   ;   CALL iom_put( "petrd_zdf" , zpe )   ! lateral  diffusion (K_z)
129      CASE ( jptra_zdfp )   ;   CALL iom_put( "petrd_zdfp", zpe )   ! vertical diffusion (K_z)
130      CASE ( jptra_dmp  )   ;   CALL iom_put( "petrd_dmp" , zpe )   ! internal 3D restoring (tradmp)
131      CASE ( jptra_bbl  )   ;   CALL iom_put( "petrd_bbl" , zpe )   ! bottom boundary layer
132      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment
133      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_nsr" , zpe )   ! surface forcing + runoff (ln_rnf=T)
134      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat
135      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
136      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
137                                !IF( .NOT.lk_vvl ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
138                                !   CALL wrk_alloc( jpi, jpj, z2d )
139                                !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
140                                !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
141                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt )
142                                !   CALL iom_put( "petrd_sad" , z2d )
143                                !   CALL wrk_dealloc( jpi, jpj, z2d )
144                                !ENDIF
145         !
146      END SELECT
147      !
148      CALL wrk_dealloc( jpi, jpj, jpk, zpe )
149      !
150      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
151   END SUBROUTINE trd_pen
152
153
154   SUBROUTINE trd_pen_init
155      !!---------------------------------------------------------------------
156      !!                  ***  ROUTINE trd_pen_init  ***
157      !!
158      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
159      !!----------------------------------------------------------------------
160      INTEGER  ::   ji, jj, jk   ! dummy loop indices
161      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
162      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
163      REAL(KIND=jprb)               :: zhook_handle
164
165      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_PEN_INIT'
166
167      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
168
169      !!----------------------------------------------------------------------
170      !
171      IF(lwp) THEN
172         WRITE(numout,*)
173         WRITE(numout,*) 'trd_pen_init : 3D Potential ENergy trends'
174         WRITE(numout,*) '~~~~~~~~~~~~~'
175      ENDIF
176      !                           ! allocate box volume arrays
177      IF ( trd_pen_alloc() /= 0 )   CALL ctl_stop('trd_pen_alloc: failed to allocate arrays')
178      !
179      rab_pe(:,:,:,:) = 0._wp
180      !
181!      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
182      !
183      nkstp     = nit000 - 1
184      !
185      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
186   END SUBROUTINE trd_pen_init
187
188   !!======================================================================
189END MODULE trdpen
Note: See TracBrowser for help on using the repository browser.