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_fix_diag_bitcomp/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/UKMO/dev_r5518_fix_diag_bitcomp/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 @ 9502

Last change on this file since 9502 was 9502, checked in by frrh, 6 years ago

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