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.
trdtrc.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.
File size: 13.9 KB
Line 
1MODULE trdtrc
2   !!======================================================================
3   !!                       ***  MODULE  trdtrc  ***
4   !! Ocean diagnostics:  mixed layer passive tracer trends
5   !!======================================================================
6   !! History :  3.0  !  2010-07  (C. Ethe)  Original code (from trdtrc.F90)
7   !!----------------------------------------------------------------------
8#if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_trdtrc )
9   !!----------------------------------------------------------------------
10   !!   'key_trdmxl_trc'                  mixed layer trend diagnostics
11   !!   'key_trdtrc'                      3D trend diagnostics
12   !!----------------------------------------------------------------------
13   !!   trdtrc      : passive tracer trends
14   !!----------------------------------------------------------------------
15   USE trc               ! tracer definitions (trn, trb, tra, etc.)
16   USE trcnam_trp
17   USE trd_oce
18   USE trdtrc_oce       ! definition of main arrays used for trends computations
19   USE trdmxl_trc        ! Mixed layer trends diag.
20   USE iom               ! I/O library
21# if defined key_debug_medusa
22   USE trcstat,          ONLY: trc_rst_dia_stat     
23# endif
24
25   USE yomhook, ONLY: lhook, dr_hook
26   USE parkind1, ONLY: jprb, jpim
27
28   IMPLICIT NONE
29   PRIVATE
30
31   INTERFACE trd_trc
32      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
33   END INTERFACE
34
35   PUBLIC trd_trc
36
37   !! * Substitutions
38#  include "top_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
41   !! $Id$
42   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
48      !!----------------------------------------------------------------------
49      !!                  ***  ROUTINE trd_trc  ***
50      !!----------------------------------------------------------------------
51      INTEGER, INTENT( in )  ::   kt                                  ! time step
52      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
53      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
54      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
55      CHARACTER (len=20) :: cltra
56      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
57      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
58      REAL(KIND=jprb)               :: zhook_handle
59
60      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRC_TRP'
61
62      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
63
64      !!----------------------------------------------------------------------
65
66      IF( kt == nittrc000 ) THEN
67!         IF(lwp)WRITE(numout,*)
68!         IF(lwp)WRITE(numout,*) 'trd_trc:'
69!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
70      ENDIF
71
72      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
73      ! Mixed layer trends for passive tracers
74      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
75#if defined key_trdmxl_trc 
76      IF( lk_trdmxl_trc .AND. ln_trdtrc( kjn ) ) THEN
77         !
78         SELECT CASE ( ktrd )
79         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )
80         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )
81         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )
82         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
83         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )
84         CASE ( jptra_zdf     )
85            IF( ln_trcldf_iso ) THEN
86               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
87            ELSE
88               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )
89            ENDIF
90         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )
91         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )
92         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )
93         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )
94         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )
95         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )
96         END SELECT
97         !
98      END IF
99#endif
100
101      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
102      !! JPALM -- 17-08-2017 -- modif following trd_tra_iom as suggested by Georges
103      !!                     -- add jptra_tot; jptra_totad; jptra_zdfp
104      !!                     -- shange to output trends every 2 time-step, except tot.
105      !!                     -- move cltra and iomput inside the select case
106      !!                     So if an non-wanted case arrives here it will not go
107      !!                     through cltra (without value) and break iomput.
108      !!                     -- Add iom_use in prevision of not using All trends
109      !!                     for All passive tracers (will create a HUGE 3D file otherwise --
110      !!                     might be interested in very few of them : SMS and TOT probably)
111         !
112         SELECT CASE( ktrd )
113         !! tot - output every time-step:
114         CASE( jptra_tot  )       ;    WRITE (cltra,'("TOT_",4a)')
115                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
116                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
117         END SELECT
118         !
119       IF( MOD( kt, 2 ) == 0 ) THEN
120         SELECT CASE( ktrd )
121         CASE( jptra_xad  )       ;    WRITE (cltra,'("XAD_",4a)')
122                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
123                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
124         CASE( jptra_yad  )       ;    WRITE (cltra,'("YAD_",4a)')
125                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
126                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
127         CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')      !! care vvl case
128                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
129                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
130         CASE( jptra_totad  )     ;    WRITE (cltra,'("TAD_",4a)')      !! total adv
131                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
132                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
133         CASE( jptra_ldf  )       ;    WRITE (cltra,'("LDF_",4a)')
134                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
135                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
136         CASE( jptra_bbl  )       ;    WRITE (cltra,'("BBL_",4a)')
137                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
138                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
139         CASE( jptra_nsr  )       ;    WRITE (cltra,'("FOR_",4a)')
140                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
141                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
142         CASE( jptra_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)')
143                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
144                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
145         CASE( jptra_zdfp )       ;    WRITE (cltra,'("ZDP_",4a)')
146                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
147                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
148         CASE( jptra_dmp  )       ;    WRITE (cltra,'("DMP_",4a)')
149                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
150                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
151         CASE( jptra_sms  )       ;    WRITE (cltra,'("SMS_",4a)')
152                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
153                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
154         CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)')
155                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
156                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
157         CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)')
158                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
159                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
160         END SELECT
161       ELSE IF( MOD( kt, 2 ) == 1 ) THEN
162         SELECT CASE( ktrd )
163         CASE( jptra_atf  )       ;    WRITE (cltra,'("ATF_",4a)')
164                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
165                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
166         END SELECT
167       END IF
168         !
169      END IF
170
171      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
172   END SUBROUTINE trd_trc_trp
173
174   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
175      !!----------------------------------------------------------------------
176      !!                  ***  ROUTINE trd_bio  ***
177      !!----------------------------------------------------------------------
178
179      INTEGER, INTENT( in )  ::   kt                                  ! time step
180      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
181      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
182      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
183      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
184      REAL(KIND=jprb)               :: zhook_handle
185
186      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRC_BIO'
187
188      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
189
190      !!----------------------------------------------------------------------
191
192#if defined key_trdmxl_trc 
193      CALL trd_mxl_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
194#endif
195
196      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
197   END SUBROUTINE trd_trc_bio
198
199   SUBROUTINE trd_trc_iomput( cltra, ptrtrd, kjn, kt )
200      !!----------------------------------------------------------------------
201      !!                  ***  ROUTINE trd_trc_iomput  ***
202      !!----------------------------------------------------------------------
203      INTEGER, INTENT( in )  ::   kt                                  ! timestep
204      INTEGER, INTENT( in )  ::   kjn                                 ! biotrend index
205      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! var trend
206      CHARACTER (len=*),INTENT( in ) :: cltra                         ! trend name
207      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
208      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
209      REAL(KIND=jprb)               :: zhook_handle
210
211      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRC_IOMPUT'
212
213      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
214
215      !!----------------------------------------------------------------------
216
217
218      IF  (iom_use(cltra)) THEN
219# if defined key_debug_medusa
220         IF(lwp) WRITE(numout,*) ' TREND stats (min, max,sum) kt = ',kt ,' jn = ',kjn
221         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra)
222# endif
223         CALL iom_put( cltra,  ptrtrd(:,:,:) )
224# if defined key_debug_medusa
225      ELSE
226         IF(lwp) WRITE(numout,*) &
227                      ' TREND -- No output asked for ',cltra,' kt = ',kt,' jn = ',kjn
228         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra)
229# endif
230      ENDIF
231
232      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
233   END SUBROUTINE trd_trc_iomput
234
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option :                                       Empty module
239   !!----------------------------------------------------------------------
240
241   INTERFACE trd_trc
242      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
243   END INTERFACE
244
245CONTAINS
246
247   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
248      INTEGER               , INTENT( in )     ::   kt      ! time step
249      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
250      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
251      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
252      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
253      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
254      REAL(KIND=jprb)               :: zhook_handle
255
256      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRC_TRP'
257
258      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
259
260      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
261      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
262      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
263      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
264      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
265   END SUBROUTINE trd_trc_trp
266
267   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
268      INTEGER               , INTENT( in )     ::   kt      ! time step
269      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
270      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Temperature or U trend
271      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
272      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
273      REAL(KIND=jprb)               :: zhook_handle
274
275      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_TRC_BIO'
276
277      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
278
279      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrbio(1,1,1)
280      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
281      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
282      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
283   END SUBROUTINE trd_trc_bio
284
285#endif
286   !!======================================================================
287END MODULE trdtrc
Note: See TracBrowser for help on using the repository browser.