source: branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 @ 8470

Last change on this file since 8470 was 8470, checked in by jpalmier, 4 years ago

JPALM — 29-08-2017 — trends bug fix TOT, ZDF, ZDP

File size: 12.1 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   IMPLICIT NONE
26   PRIVATE
27
28   INTERFACE trd_trc
29      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
30   END INTERFACE
31
32   PUBLIC trd_trc
33
34   !! * Substitutions
35#  include "top_substitute.h90"
36   !!----------------------------------------------------------------------
37   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
38   !! $Id$
39   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE trd_trc  ***
47      !!----------------------------------------------------------------------
48      INTEGER, INTENT( in )  ::   kt                                  ! time step
49      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
50      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
51      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
52      CHARACTER (len=20) :: cltra
53      !!----------------------------------------------------------------------
54
55      IF( kt == nittrc000 ) THEN
56!         IF(lwp)WRITE(numout,*)
57!         IF(lwp)WRITE(numout,*) 'trd_trc:'
58!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
59      ENDIF
60
61      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
62      ! Mixed layer trends for passive tracers
63      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
64#if defined key_trdmxl_trc 
65      IF( lk_trdmxl_trc .AND. ln_trdtrc( kjn ) ) THEN
66         !
67         SELECT CASE ( ktrd )
68         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )
69         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )
70         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )
71         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
72         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )
73         CASE ( jptra_zdf     )
74            IF( ln_trcldf_iso ) THEN
75               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
76            ELSE
77               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )
78            ENDIF
79         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )
80         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )
81         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )
82         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )
83         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )
84         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )
85         END SELECT
86         !
87      END IF
88#endif
89
90      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
91      !! JPALM -- 17-08-2017 -- modif following trd_tra_iom as suggested by Georges
92      !!                     -- add jptra_tot; jptra_totad; jptra_zdfp
93      !!                     -- shange to output trends every 2 time-step, except tot.
94      !!                     -- move cltra and iomput inside the select case
95      !!                     So if an non-wanted case arrives here it will not go
96      !!                     through cltra (without value) and break iomput.
97      !!                     -- Add iom_use in prevision of not using All trends
98      !!                     for All passive tracers (will create a HUGE 3D file otherwise --
99      !!                     might be interested in very few of them : SMS and TOT probably)
100         !
101         SELECT CASE( ktrd )
102         !! tot - output every time-step:
103         CASE( jptra_tot  )       ;    WRITE (cltra,'("TOT_",4a)')
104                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
105                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
106         END SELECT
107         !
108       IF( MOD( kt, 2 ) == 0 ) THEN
109         SELECT CASE( ktrd )
110         CASE( jptra_xad  )       ;    WRITE (cltra,'("XAD_",4a)')
111                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
112                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
113         CASE( jptra_yad  )       ;    WRITE (cltra,'("YAD_",4a)')
114                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
115                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
116         CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')      !! care vvl case
117                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
118                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
119         CASE( jptra_totad  )     ;    WRITE (cltra,'("TAD_",4a)')      !! total adv
120                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
121                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
122         CASE( jptra_ldf  )       ;    WRITE (cltra,'("LDF_",4a)')
123                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
124                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
125         CASE( jptra_bbl  )       ;    WRITE (cltra,'("BBL_",4a)')
126                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
127                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
128         CASE( jptra_nsr  )       ;    WRITE (cltra,'("FOR_",4a)')
129                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
130                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
131         CASE( jptra_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)')
132                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
133                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
134         CASE( jptra_zdfp )       ;    WRITE (cltra,'("ZDP_",4a)')
135                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
136                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
137         CASE( jptra_dmp  )       ;    WRITE (cltra,'("DMP_",4a)')
138                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
139                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
140         CASE( jptra_sms  )       ;    WRITE (cltra,'("SMS_",4a)')
141                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
142                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
143         CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)')
144                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
145                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
146         CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)')
147                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
148                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
149         END SELECT
150       ELSE IF( MOD( kt, 2 ) == 1 ) THEN
151         SELECT CASE( ktrd )
152         CASE( jptra_atf  )       ;    WRITE (cltra,'("ATF_",4a)')
153                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
154                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt )
155         END SELECT
156       END IF
157         !
158      END IF
159
160   END SUBROUTINE trd_trc_trp
161
162   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
163      !!----------------------------------------------------------------------
164      !!                  ***  ROUTINE trd_bio  ***
165      !!----------------------------------------------------------------------
166
167      INTEGER, INTENT( in )  ::   kt                                  ! time step
168      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
169      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
170      !!----------------------------------------------------------------------
171
172#if defined key_trdmxl_trc 
173      CALL trd_mxl_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
174#endif
175
176   END SUBROUTINE trd_trc_bio
177
178   SUBROUTINE trd_trc_iomput( cltra, ptrtrd, kjn, kt )
179      !!----------------------------------------------------------------------
180      !!                  ***  ROUTINE trd_trc_iomput  ***
181      !!----------------------------------------------------------------------
182      INTEGER, INTENT( in )  ::   kt                                  ! timestep
183      INTEGER, INTENT( in )  ::   kjn                                 ! biotrend index
184      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! var trend
185      CHARACTER (len=*),INTENT( in ) :: cltra                         ! trend name
186      !!----------------------------------------------------------------------
187
188
189      IF  (iom_use(cltra)) THEN
190# if defined key_debug_medusa
191         IF(lwp) WRITE(numout,*) ' TREND stats (min, max,sum) kt = ',kt ,' jn = ',kjn
192         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra)
193# endif
194         CALL iom_put( cltra,  ptrtrd(:,:,:) )
195# if defined key_debug_medusa
196      ELSE
197         IF(lwp) WRITE(numout,*) &
198                      ' TREND -- No output asked for ',cltra,' kt = ',kt,' jn = ',kjn
199         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra)
200# endif
201      ENDIF
202
203   END SUBROUTINE trd_trc_iomput
204
205
206#else
207   !!----------------------------------------------------------------------
208   !!   Default option :                                       Empty module
209   !!----------------------------------------------------------------------
210
211   INTERFACE trd_trc
212      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
213   END INTERFACE
214
215CONTAINS
216
217   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
218      INTEGER               , INTENT( in )     ::   kt      ! time step
219      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
220      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
221      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
222      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
223      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
224      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
225      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
226   END SUBROUTINE trd_trc_trp
227
228   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
229      INTEGER               , INTENT( in )     ::   kt      ! time step
230      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
231      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Temperature or U trend
232      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrbio(1,1,1)
233      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
234      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
235   END SUBROUTINE trd_trc_bio
236
237#endif
238   !!======================================================================
239END MODULE trdtrc
Note: See TracBrowser for help on using the repository browser.