source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRD/trdpen.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 2 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 7.4 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         ! lateral diffusion: eddy diffusivity & EIV coeff.
20   USE zdfddm         ! vertical physics: double diffusion
21   USE phycst         ! physical constants
22   !
23   USE in_out_manager ! I/O manager
24   USE iom            ! I/O manager library
25   USE lib_mpp        ! MPP library
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 "vectopt_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
41   !! $Id$
42   !! Software governed by the CeCILL license (see ./LICENSE)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   INTEGER FUNCTION trd_pen_alloc()
47      !!---------------------------------------------------------------------
48      !!                  ***  FUNCTION trd_tra_alloc  ***
49      !!---------------------------------------------------------------------
50      ALLOCATE( rab_pe(jpi,jpj,jpk,jpts) , STAT= trd_pen_alloc )
51      !
52      CALL mpp_sum ( 'trdpen', trd_pen_alloc )
53      IF( trd_pen_alloc /= 0 )   CALL ctl_stop( 'STOP',  'trd_pen_alloc: failed to allocate arrays'  )
54   END FUNCTION trd_pen_alloc
55
56
57   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm )
58      !!---------------------------------------------------------------------
59      !!                  ***  ROUTINE trd_tra_mng  ***
60      !!
61      !! ** Purpose :   Dispatch all trends computation, e.g. 3D output, integral
62      !!                constraints, barotropic vorticity, kinetic enrgy,
63      !!                potential energy, and/or mixed layer budget.
64      !!----------------------------------------------------------------------
65      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   ptrdx, ptrdy   ! Temperature & Salinity trends
66      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index
67      INTEGER                   , INTENT(in) ::   kt             ! time step index
68      INTEGER                   , INTENT(in) ::   Kmm            ! time level index
69      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s]
70      !
71      INTEGER ::   jk                                            ! dummy loop indices
72      REAL(wp), ALLOCATABLE, DIMENSION(:,:)      ::   z2d            ! 2D workspace
73      REAL(wp), DIMENSION(jpi,jpj,jpk)           ::   zpe            ! 3D workspace
74      !!----------------------------------------------------------------------
75      !
76      zpe(:,:,:) = 0._wp
77      !
78      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step
79         nkstp = kt
80         CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe )
81         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
82         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
83         CALL iom_put( "PEanom" , zpe )
84      ENDIF
85      !
86      zpe(:,:,jpk) = 0._wp
87      DO jk = 1, jpkm1
88         zpe(:,:,jk) = ( - ( rab_n(:,:,jk,jp_tem) + rab_pe(:,:,jk,jp_tem) ) * ptrdx(:,:,jk)   &
89            &            + ( rab_n(:,:,jk,jp_sal) + rab_pe(:,:,jk,jp_sal) ) * ptrdy(:,:,jk)  )
90      END DO
91
92      SELECT CASE ( ktrd )
93      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection
94      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
95      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
96                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
97                                   ALLOCATE( z2d(jpi,jpj) )
98                                   z2d(:,:) = ww(:,:,1) * ( &
99                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm)    &
100                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm)    &
101                                     & ) / e3t(:,:,1,Kmm)
102                                   CALL iom_put( "petrd_sad" , z2d )
103                                   DEALLOCATE( z2d )
104                                ENDIF
105      CASE ( jptra_ldf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion
106      CASE ( jptra_zdf  )   ;   CALL iom_put( "petrd_zdf" , zpe )   ! lateral  diffusion (K_z)
107      CASE ( jptra_zdfp )   ;   CALL iom_put( "petrd_zdfp", zpe )   ! vertical diffusion (K_z)
108      CASE ( jptra_dmp  )   ;   CALL iom_put( "petrd_dmp" , zpe )   ! internal 3D restoring (tradmp)
109      CASE ( jptra_bbl  )   ;   CALL iom_put( "petrd_bbl" , zpe )   ! bottom boundary layer
110      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment
111      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_nsr" , zpe )   ! surface forcing + runoff (ln_rnf=T)
112      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat
113      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
114      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
115         !
116      END SELECT
117      !
118      !
119   END SUBROUTINE trd_pen
120
121
122   SUBROUTINE trd_pen_init
123      !!---------------------------------------------------------------------
124      !!                  ***  ROUTINE trd_pen_init  ***
125      !!
126      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
127      !!----------------------------------------------------------------------
128      INTEGER  ::   ji, jj, jk   ! dummy loop indices
129      !!----------------------------------------------------------------------
130      !
131      IF(lwp) THEN
132         WRITE(numout,*)
133         WRITE(numout,*) 'trd_pen_init : 3D Potential ENergy trends'
134         WRITE(numout,*) '~~~~~~~~~~~~~'
135      ENDIF
136      !                           ! allocate box volume arrays
137      IF ( trd_pen_alloc() /= 0 )   CALL ctl_stop('trd_pen_alloc: failed to allocate arrays')
138      !
139      rab_pe(:,:,:,:) = 0._wp
140      !
141      IF( .NOT.ln_linssh )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
142      !
143      nkstp     = nit000 - 1
144      !
145   END SUBROUTINE trd_pen_init
146
147   !!======================================================================
148END MODULE trdpen
Note: See TracBrowser for help on using the repository browser.