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.
trctrp.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90 @ 5105

Last change on this file since 5105 was 5105, checked in by cbricaud, 9 years ago

bug correction
  • Property svn:keywords set to Id
File size: 8.8 KB
Line 
1MODULE trctrp
2   !!======================================================================
3   !!                       ***  MODULE trctrp  ***
4   !! Ocean Physics    : manage the passive tracer transport
5   !!======================================================================
6   !! History :   1.0  !  2004-03 (C. Ethe) Original code
7   !!             3.3  !  2010-07 (C. Ethe) Merge TRA-TRC
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP models
12   !!----------------------------------------------------------------------
13   !!   trc_trp        : passive tracer transport
14   !!----------------------------------------------------------------------
15   USE oce_trc         ! ocean dynamics and active tracers variables
16   USE trc             ! ocean passive tracers variables
17   USE trcnam_trp      ! passive tracers transport namelist variables
18   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
19   USE trabbl_crs      ! bottom boundary layer               (trc_bbl routine)
20   USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
21   USE trcbbl_crs      ! bottom boundary layer               (trc_bbl routine)
22   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
23   USE trcdmp          ! internal damping                    (trc_dmp routine)
24   USE trcldf          ! lateral mixing                      (trc_ldf routine)
25   USE trcldf_crs      ! lateral mixing                      (trc_ldf routine)
26   USE trcadv          ! advection                           (trc_adv routine)
27   USE trcadv_crs      ! advection                           (trc_adv routine)
28   USE trczdf          ! vertical diffusion                  (trc_zdf routine)
29   USE trczdf_crs      ! vertical diffusion                  (trc_zdf routine
30   USE trcnxt          ! time-stepping                       (trc_nxt routine)
31   USE trcrad          ! positivity                          (trc_rad routine)
32   USE trcsbc          ! surface boundary condition          (trc_sbc routine)
33   USE trcsbc_crs      ! surface boundary condition          (trc_sbc routine)
34   USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
35   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine)
36   USE dom_oce , ONLY : ln_crs
37   USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr
38
39#if defined key_agrif
40   USE agrif_top_sponge ! tracers sponges
41   USE agrif_top_update ! tracers updates
42#endif
43
44   IMPLICIT NONE
45   PRIVATE
46
47   PUBLIC   trc_trp    ! called by trc_stp
48
49   !! * Substitutions
50#  include "top_substitute.h90"
51   !!----------------------------------------------------------------------
52   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
53   !! $Id$
54   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56
57CONTAINS
58
59   SUBROUTINE trc_trp( kstp )
60      !!----------------------------------------------------------------------
61      !!                     ***  ROUTINE trc_trp  ***
62      !!                     
63      !! ** Purpose :   Management of passive tracers transport
64      !!
65      !! ** Method  : - Compute the passive tracers trends
66      !!              - Update the passive tracers
67      !!----------------------------------------------------------------------
68      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
69      REAL(wp) :: zmin,zmax
70      INTEGER :: ji,jj,jk
71      !! ---------------------------------------------------------------------
72      !
73      IF( nn_timing == 1 )   CALL timing_start('trc_trp')
74      !
75      IF( .NOT. lk_c1d ) THEN
76         !
77!         CALL test(kstp,1)
78!         IF( ln_crs ) THEN ;    CALL trc_sbc_crs( kstp )
79!         ELSE              ;    CALL trc_sbc( kstp )
80!         ENDIF
81!         CALL test(kstp,2)
82         IF( ln_crs ) THEN ;    CALL trc_bbl_crs( kstp )
83         ELSE              ;    CALL trc_bbl( kstp )
84         ENDIF
85         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
86!         CALL test(kstp,3)
87
88         IF( ln_crs ) THEN ;    CALL trc_adv_crs( kstp )
89         ELSE              ;    CALL trc_adv( kstp )
90         ENDIF
91!         CALL test(kstp,4)
92
93         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only
94         IF( ln_crs ) THEN ;    CALL trc_ldf_crs( kstp )
95         ELSE              ;    CALL trc_ldf( kstp )
96         ENDIF
97!         CALL test(kstp,5)
98         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
99            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
100#if defined key_agrif
101         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
102#endif
103         IF( ln_crs ) THEN ;    CALL trc_zdf_crs( kstp )
104         ELSE              ;    CALL trc_zdf( kstp )
105         ENDIF
106!         CALL test(kstp,6)
107                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
108!         CALL test(kstp,7)
109         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
110
111#if defined key_agrif
112      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
113#endif
114         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
115         IF( ln_zps    )THEN
116         IF( ln_crs ) THEN ;    CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv )
117         ELSE              ;    CALL zps_hde( kstp, jptra, trn, gtru, gtrv )
118         ENDIF
119         ENDIF
120                                                                ! tracers at the bottom ocean level
121         !
122      ELSE                                               ! 1D vertical configuration
123                                CALL trc_sbc( kstp )            ! surface boundary condition
124         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
125            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
126                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
127                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
128          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
129         !
130      END IF
131      !
132      IF( nn_timing == 1 )   CALL timing_stop('trc_trp')
133      !
134   END SUBROUTINE trc_trp
135   SUBROUTINE test(kt,i)
136   INTEGER,INTENT(IN) :: kt,i
137   REAL(wp)::zmin,zmax
138   INTEGER :: ji,jj,jk
139   zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
140   zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
141   IF(lwp)WRITE(numout,*)"trctrp b ",kt,i,zmin,zmax   
142   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
143   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
144   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax   
145   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin)
146   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax)
147   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax   
148   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin)
149   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax)
150   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax   
151   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin)
152   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax)
153   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax   
154
155   IF(narea==267)WRITE(narea+5000,*)"tra(17,5,74,1) = ",kt,i,tra(17,5,74,1)
156
157   DO ji=1,jpi
158   DO jj=1,jpj
159   DO jk=1,jpk
160      IF( tra(ji,jj,jk,1) .NE.  tra(ji,jj,jk,1) )WRITE(narea+200,*)"BUG7 ",ji,jj,jk, tra(ji,jj,jk,1); CALL FLUSH(narea+200)
161   ENDDO
162   ENDDO
163   ENDDO
164   
165   END SUBROUTINE test
166#else
167   !!----------------------------------------------------------------------
168   !!   Dummy module :                                        No TOP models
169   !!----------------------------------------------------------------------
170CONTAINS
171   SUBROUTINE trc_trp( kstp )              ! Empty routine
172      INTEGER, INTENT(in) ::   kstp
173      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp
174   END SUBROUTINE trc_trp
175#endif
176   
177   !!======================================================================
178END MODULE trctrp
Note: See TracBrowser for help on using the repository browser.