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

source: branches/UKMO/r5518_amm15_test/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 @ 7144

Last change on this file since 7144 was 7144, checked in by jcastill, 7 years ago

Remove svn keywords

File size: 7.6 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 trd_oce
17   USE trdtrc_oce       ! definition of main arrays used for trends computations
18   USE trdmxl_trc        ! Mixed layer trends diag.
19   USE iom               ! I/O library
20
21   IMPLICIT NONE
22   PRIVATE
23
24   INTERFACE trd_trc
25      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
26   END INTERFACE
27
28   PUBLIC trd_trc
29
30   !!----------------------------------------------------------------------
31   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
32   !! $Id$
33   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35
36CONTAINS
37
38   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
39      !!----------------------------------------------------------------------
40      !!                  ***  ROUTINE trd_trc  ***
41      !!----------------------------------------------------------------------
42      INTEGER, INTENT( in )  ::   kt                                  ! time step
43      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
44      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
45      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
46      CHARACTER (len=20) :: cltra
47      !!----------------------------------------------------------------------
48
49      IF( kt == nittrc000 ) THEN
50!         IF(lwp)WRITE(numout,*)
51!         IF(lwp)WRITE(numout,*) 'trd_trc:'
52!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
53      ENDIF
54
55      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
56      ! Mixed layer trends for passive tracers
57      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
58#if defined key_trdmxl_trc 
59      IF( lk_trdmxl_trc .AND. ln_trdtrc( kjn ) ) THEN
60         !
61         SELECT CASE ( ktrd )
62         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )
63         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )
64         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )
65         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
66         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )
67         CASE ( jptra_zdf     )
68            IF( ln_trcldf_iso ) THEN
69               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
70            ELSE
71               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )
72            ENDIF
73         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )
74         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )
75         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )
76         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )
77         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )
78         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )
79         END SELECT
80         !
81      END IF
82#endif
83
84      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
85         !
86         SELECT CASE( ktrd )
87         CASE( jptra_xad  )       ;    WRITE (cltra,'("XAD_",4a)')
88         CASE( jptra_yad  )       ;    WRITE (cltra,'("YAD_",4a)')
89         CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')
90         CASE( jptra_ldf  )       ;    WRITE (cltra,'("LDF_",4a)')
91         CASE( jptra_bbl  )       ;    WRITE (cltra,'("BBL_",4a)')
92         CASE( jptra_nsr  )       ;    WRITE (cltra,'("FOR_",4a)')
93         CASE( jptra_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)')
94         CASE( jptra_dmp  )       ;    WRITE (cltra,'("DMP_",4a)')
95         CASE( jptra_sms  )       ;    WRITE (cltra,'("SMS_",4a)')
96         CASE( jptra_atf  )       ;    WRITE (cltra,'("ATF_",4a)')
97         CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)')
98         CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)')
99         END SELECT
100                                          cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
101                                          CALL iom_put( cltra,  ptrtrd(:,:,:) )
102         !
103      END IF
104
105   END SUBROUTINE trd_trc_trp
106
107   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
108      !!----------------------------------------------------------------------
109      !!                  ***  ROUTINE trd_bio  ***
110      !!----------------------------------------------------------------------
111
112      INTEGER, INTENT( in )  ::   kt                                  ! time step
113      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
114      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
115      !!----------------------------------------------------------------------
116
117#if defined key_trdmxl_trc 
118      CALL trd_mxl_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
119#endif
120
121   END SUBROUTINE trd_trc_bio
122#else
123   !!----------------------------------------------------------------------
124   !!   Default option :                                       Empty module
125   !!----------------------------------------------------------------------
126
127   INTERFACE trd_trc
128      MODULE PROCEDURE trd_trc_trp, trd_trc_bio
129   END INTERFACE
130
131CONTAINS
132
133   SUBROUTINE trd_trc_trp( ptrtrd, kjn, ktrd, kt )
134      INTEGER               , INTENT( in )     ::   kt      ! time step
135      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
136      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
137      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
138      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
139      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
140      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
141      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
142   END SUBROUTINE trd_trc_trp
143
144   SUBROUTINE trd_trc_bio( ptrbio, ktrd, kt )
145      INTEGER               , INTENT( in )     ::   kt      ! time step
146      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
147      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Temperature or U trend
148      WRITE(*,*) 'trd_trc_trp : You should not have seen this print! error?', ptrbio(1,1,1)
149      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
150      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
151   END SUBROUTINE trd_trc_bio
152
153#endif
154   !!======================================================================
155END MODULE trdtrc
Note: See TracBrowser for help on using the repository browser.