source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcsbc.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 2 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 9.4 KB
Line 
1MODULE trcsbc
2   !!==============================================================================
3   !!                       ***  MODULE  trcsbc  ***
4   !! Ocean passive tracers:  surface boundary condition
5   !!======================================================================
6   !! History :  8.2  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
8   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
9   !!            9.0  !  2004-03  (C. Ethe)  adapted for passive tracers
10   !!                 !  2006-08  (C. Deltel) Diagnose ML trends for passive tracers
11   !!==============================================================================
12#if defined key_top
13   !!----------------------------------------------------------------------
14   !!   'key_top'                                                TOP models
15   !!----------------------------------------------------------------------
16   !!   trc_sbc      : update the tracer trend at ocean surface
17   !!----------------------------------------------------------------------
18   USE oce_trc         ! ocean dynamics and active tracers variables
19   USE trc             ! ocean  passive tracers variables
20   USE prtctl_trc      ! Print control for debbuging
21   USE iom
22   USE trd_oce
23   USE trdtra
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   trc_sbc   ! routine called by step.F90
29
30   !! * Substitutions
31#  include "vectopt_loop_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE trc_sbc ( kt, Kmm, Krhs )
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE trc_sbc  ***
42      !!                   
43      !! ** Purpose :   Compute the tracer surface boundary condition trend of
44      !!      (concentration/dilution effect) and add it to the general
45      !!       trend of tracer equations.
46      !!
47      !! ** Method :
48      !!      * concentration/dilution effect:
49      !!            The surface freshwater flux modify the ocean volume
50      !!         and thus the concentration of a tracer as :
51      !!            tra = tra + emp * trn / e3t   for k=1
52      !!         where emp, the surface freshwater budget (evaporation minus
53      !!         precipitation ) given in kg/m2/s is divided
54      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s.
55      !!
56      !! ** Action  : - Update the 1st level of tra with the trend associated
57      !!                with the tracer surface boundary condition
58      !!
59      !!----------------------------------------------------------------------
60      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
61      INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices
62      !
63      INTEGER  ::   ji, jj, jn                      ! dummy loop indices
64      REAL(wp) ::   zse3t, zrtrn, zratio, zfact     ! local scalars
65      REAL(wp) ::   zftra, zcd, zdtra, ztfx, ztra   !   -      -
66      CHARACTER (len=22) :: charout
67      REAL(wp), DIMENSION(jpi,jpj)   ::   zsfx
68      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd
69      !!---------------------------------------------------------------------
70      !
71      IF( ln_timing )   CALL timing_start('trc_sbc')
72      !
73      ! Allocate temporary workspace
74      IF( l_trdtrc )  ALLOCATE( ztrtrd(jpi,jpj,jpk) )
75      !
76      zrtrn = 1.e-15_wp
77
78      IF( kt == nittrc000 ) THEN
79         IF(lwp) WRITE(numout,*)
80         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
81         IF(lwp) WRITE(numout,*) '~~~~~~~ '
82         !
83         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file
84            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
85            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
86            zfact = 0.5_wp
87            DO jn = 1, jptra
88               CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc
89            END DO
90         ELSE                                         ! No restart or restart not found: Euler forward time stepping
91           zfact = 1._wp
92           sbc_trc_b(:,:,:) = 0._wp
93         ENDIF
94      ELSE                                         ! Swap of forcing fields
95         IF( ln_top_euler ) THEN
96            zfact = 1._wp
97            sbc_trc_b(:,:,:) = 0._wp
98         ELSE
99            zfact = 0.5_wp
100            sbc_trc_b(:,:,:) = sbc_trc(:,:,:)
101         ENDIF
102         !
103      ENDIF
104
105      ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div
106      ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice
107      ! Coupling offline : runoff are in emp which contains E-P-R
108      !
109      IF( .NOT.ln_linssh ) THEN  ! online coupling with vvl
110         zsfx(:,:) = 0._wp
111      ELSE                                      ! online coupling free surface or offline with free surface
112         zsfx(:,:) = emp(:,:)
113      ENDIF
114
115      ! 0. initialization
116      IF( nn_ice_tr == -1 ) THEN    ! No tracers in sea ice (null concentration in sea ice)
117         !
118         DO jn = 1, jptra
119            DO jj = 2, jpj
120               DO ji = fs_2, fs_jpim1   ! vector opt.
121                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
122               END DO
123            END DO
124         END DO
125         !
126       ELSE
127         !
128         DO jn = 1, jptra
129            DO jj = 2, jpj
130               DO ji = fs_2, fs_jpim1   ! vector opt.
131                  zse3t = 1. / e3t_n(ji,jj,1)
132                  ! tracer flux at the ice/ocean interface (tracer/m2/s)
133                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
134                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting,
135                  !                                         ! only used in the levitating sea ice case
136                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
137                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
138                  ztfx  = zftra                             ! net tracer flux
139                  !
140                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 
141                  IF ( zdtra < 0. ) THEN
142                     zratio = -zdtra * zse3t * r2dttrc / ( trn(ji,jj,1,jn) + zrtrn )
143                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise
144                  ENDIF
145                  sbc_trc(ji,jj,jn) =  zdtra 
146               END DO
147            END DO
148         END DO
149      ENDIF
150      !
151      CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. )
152      !                                       Concentration dilution effect on tracers due to evaporation & precipitation
153      DO jn = 1, jptra
154         !
155         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
156         !
157         DO jj = 2, jpj
158            DO ji = fs_2, fs_jpim1   ! vector opt.
159               zse3t = zfact / e3t_n(ji,jj,1)
160               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
161            END DO
162         END DO
163         !
164         IF( l_trdtrc ) THEN
165            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
166            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd )
167         END IF
168         !                                                       ! ===========
169      END DO                                                     ! tracer loop
170      !                                                          ! ===========
171      !
172      !                                           Write in the tracer restar  file
173      !                                          *******************************
174      IF( lrst_trc .AND. .NOT.ln_top_euler ) THEN
175         IF(lwp) WRITE(numout,*)
176         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   &
177            &                    'at it= ', kt,' date= ', ndastp
178         IF(lwp) WRITE(numout,*) '~~~~'
179         DO jn = 1, jptra
180            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) )
181         END DO
182      ENDIF
183      !
184      IF( ln_ctl )   THEN
185         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
186                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
187      ENDIF
188      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
189      !
190      IF( ln_timing )   CALL timing_stop('trc_sbc')
191      !
192   END SUBROUTINE trc_sbc
193
194#else
195   !!----------------------------------------------------------------------
196   !!   Dummy module :                      NO passive tracer
197   !!----------------------------------------------------------------------
198CONTAINS
199   SUBROUTINE trc_sbc (kt)              ! Empty routine
200      INTEGER, INTENT(in) :: kt
201      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
202   END SUBROUTINE trc_sbc
203#endif
204   
205   !!======================================================================
206END MODULE trcsbc
Note: See TracBrowser for help on using the repository browser.