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.
trasbc.F90 in NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA – NEMO

source: NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trasbc.F90 @ 13518

Last change on this file since 13518 was 13518, checked in by hadcv, 4 years ago

Tiling for modules before tra_adv
  • Property svn:keywords set to Id
File size: 12.6 KB
Line 
1MODULE trasbc
2   !!==============================================================================
3   !!                       ***  MODULE  trasbc  ***
4   !! Ocean active tracers:  surface boundary condition
5   !!==============================================================================
6   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
8   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module
9   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
10   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
11   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing
12   !!            4.1  !  2019-09  (P. Mathiot) isf moved in traisf
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   tra_sbc       : update the tracer trend at ocean surface
17   !!----------------------------------------------------------------------
18   USE oce            ! ocean dynamics and active tracers
19   USE sbc_oce        ! surface boundary condition: ocean
20   USE dom_oce        ! ocean space domain variables
21   ! TEMP: This change not necessary after trd_tra is tiled
22   USE domain, ONLY : dom_tile
23   USE phycst         ! physical constant
24   USE eosbn2         ! Equation Of State
25   USE sbcmod         ! ln_rnf 
26   USE sbcrnf         ! River runoff 
27   USE traqsr         ! solar radiation penetration
28   USE trd_oce        ! trends: ocean variables
29   USE trdtra         ! trends manager: tracers
30#if defined key_asminc   
31   USE asminc         ! Assimilation increment
32#endif
33   !
34   USE in_out_manager ! I/O manager
35   USE prtctl         ! Print control
36   USE iom            ! xIOS server
37   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
38   USE timing         ! Timing
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_sbc   ! routine called by step.F90
44
45   !! * Substitutions
46#  include "do_loop_substitute.h90"
47#  include "domzgr_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs )
56      !!----------------------------------------------------------------------
57      !!                  ***  ROUTINE tra_sbc  ***
58      !!                   
59      !! ** Purpose :   Compute the tracer surface boundary condition trend of
60      !!      (flux through the interface, concentration/dilution effect)
61      !!      and add it to the general trend of tracer equations.
62      !!
63      !! ** Method :   The (air+ice)-sea flux has two components:
64      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
65      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
66      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
67      !!             they are simply added to the tracer trend (ts(Krhs)).
68      !!               In linear free surface case (ln_linssh=T), the volume of the
69      !!             ocean does not change with the water exchanges at the (air+ice)-sea
70      !!             interface. Therefore another term has to be added, to mimic the
71      !!             concentration/dilution effect associated with water exchanges.
72      !!
73      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend
74      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
75      !!----------------------------------------------------------------------
76      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
77      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
78      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
79      !
80      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
81      INTEGER  ::   ikt, ikb                    ! local integers
82      REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar
83      ! TEMP: This change not necessary after trd_tra is tiled
84      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztrdt, ztrds
85      !!----------------------------------------------------------------------
86      !
87      IF( ln_timing )   CALL timing_start('tra_sbc')
88      !
89      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
90         IF( kt == nit000 ) THEN
91            IF(lwp) WRITE(numout,*)
92            IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
93            IF(lwp) WRITE(numout,*) '~~~~~~~ '
94         ENDIF
95      ENDIF
96      !
97      IF( l_trdtra ) THEN                    !* Save ta and sa trends
98         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
99            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled
100            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
101         ENDIF
102
103         DO_3D( 0, 0, 0, 0, 1, jpk )
104            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs)
105            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs)
106         END_3D
107      ENDIF
108      !
109!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
110      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
111         DO_2D( 0, 0, 0, 0 )
112            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns
113            qsr(ji,jj) = 0._wp                        ! qsr set to zero
114         END_2D
115      ENDIF
116
117      !----------------------------------------
118      !        EMP, SFX and QNS effects
119      !----------------------------------------
120      !                             !==  Set before sbc tracer content fields  ==!
121      IF( kt == nit000 ) THEN             !* 1st time-step
122         IF( ln_rstart .AND.    &               ! Restart: read in restart file
123              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
124            zfact = 0.5_wp
125            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
126               IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
127               sbc_tsc(:,:,:) = 0._wp
128               CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend
129               CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend
130            ENDIF
131         ELSE                                   ! No restart or restart not found: Euler forward time stepping
132            zfact = 1._wp
133            DO_2D( 0, 0, 0, 0 )
134               sbc_tsc(ji,jj,:) = 0._wp
135               sbc_tsc_b(ji,jj,:) = 0._wp
136            END_2D
137         ENDIF
138      ELSE                                !* other time-steps: swap of forcing fields
139         zfact = 0.5_wp
140         DO_2D( 0, 0, 0, 0 )
141            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
142         END_2D
143      ENDIF
144      !                             !==  Now sbc tracer content fields  ==!
145      DO_2D( 0, 0, 0, 0 )
146         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
147         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
148      END_2D
149      IF( ln_linssh ) THEN                !* linear free surface 
150         DO_2D( 0, 0, 0, 0 )
151            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
152            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
153         END_2D
154         IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile
155            IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
156            IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
157         ENDIF
158      ENDIF
159      !
160      DO jn = 1, jpts               !==  update tracer trend  ==!
161         DO_2D( 0, 0, 0, 0 )
162            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm)
163         END_2D
164      END DO
165      !                 
166      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
167         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
168            IF( lwxios ) CALL iom_swap(      cwxios_context          )
169            CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
170            CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
171            IF( lwxios ) CALL iom_swap(      cxios_context          )
172         ENDIF
173      ENDIF
174      !
175      !----------------------------------------
176      !        River Runoff effects
177      !----------------------------------------
178      !
179      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
180         zfact = 0.5_wp
181         DO_2D( 0, 0, 0, 0 )
182            IF( rnf(ji,jj) /= 0._wp ) THEN
183               zdep = zfact / h_rnf(ji,jj)
184               DO jk = 1, nk_rnf(ji,jj)
185                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                  &
186                                        &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
187                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  &
188                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
189               END DO
190            ENDIF
191         END_2D
192      ENDIF
193
194      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
195         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
196         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
197      ENDIF
198
199#if defined key_asminc
200      !
201      !----------------------------------------
202      !        Assmilation effects
203      !----------------------------------------
204      !
205      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
206          !
207         IF( ln_linssh ) THEN
208            DO_2D( 0, 0, 0, 0 )
209               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
210               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
211               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
212            END_2D
213         ELSE
214            DO_2D( 0, 0, 0, 0 )
215               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
216               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
217               pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
218            END_2D
219         ENDIF
220         !
221      ENDIF
222      !
223#endif
224      !
225      ! TEMP: These changes not necessary after trd_tra is tiled
226      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
227         DO_3D( 0, 0, 0, 0, 1, jpk )
228            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk)
229            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk)
230         END_3D
231
232         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
233            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain
234
235            ! TODO: TO BE TILED- trd_tra
236            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
237            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
238            DEALLOCATE( ztrdt , ztrds )
239
240            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain
241         ENDIF
242      ENDIF
243      !
244      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
245         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
246      !
247      IF( ln_timing )   CALL timing_stop('tra_sbc')
248      !
249   END SUBROUTINE tra_sbc
250
251   !!======================================================================
252END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.