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 branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 2690

Last change on this file since 2690 was 2690, checked in by gm, 13 years ago

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

  • 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   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   tra_sbc      : update the tracer trend at ocean surface
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and active tracers
17   USE sbc_oce         ! surface boundary condition: ocean
18   USE dom_oce         ! ocean space domain variables
19   USE phycst          ! physical constant
20   USE traqsr          ! solar radiation penetration
21   USE trdmod_oce      ! ocean trends
22   USE trdtra          ! ocean trends
23   USE in_out_manager  ! I/O manager
24   USE prtctl          ! Print control
25   USE restart         ! ocean restart
26   USE sbcrnf          ! River runoff 
27   USE sbcmod          ! ln_rnf 
28   USE iom
29   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   tra_sbc    ! routine called by step.F90
35
36   !! * Substitutions
37#  include "domzgr_substitute.h90"
38#  include "vectopt_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
41   !! $Id$
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE tra_sbc ( kt )
47      !!----------------------------------------------------------------------
48      !!                  ***  ROUTINE tra_sbc  ***
49      !!                   
50      !! ** Purpose :   Compute the tracer surface boundary condition trend of
51      !!      (flux through the interface, concentration/dilution effect)
52      !!      and add it to the general trend of tracer equations.
53      !!
54      !! ** Method :
55      !!      Following Roullet and Madec (2000), the air-sea flux can be divided
56      !!      into three effects: (1) Fext, external forcing;
57      !!      (2) Fwi, concentration/dilution effect due to water exchanged
58      !!         at the surface by evaporation, precipitations and runoff (E-P-R);
59      !!      (3) Fwe, tracer carried with the water that is exchanged.
60      !!
61      !!      Fext, flux through the air-sea interface for temperature and salt:
62      !!            - temperature : heat flux q (w/m2). If penetrative solar
63      !!         radiation q is only the non solar part of the heat flux, the
64      !!         solar part is added in traqsr.F routine.
65      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
66      !!            - salinity    : no salt flux
67      !!
68      !!      The formulation for Fwb and Fwi vary according to the free
69      !!      surface formulation (linear or variable volume).
70      !!      * Linear free surface
71      !!            The surface freshwater flux modifies the ocean volume
72      !!         and thus the concentration of a tracer and the temperature.
73      !!         First order of the effect of surface freshwater exchange
74      !!         for salinity, it can be neglected on temperature (especially
75      !!         as the temperature of precipitations and runoffs is usually
76      !!         unknown).
77      !!            - temperature : we assume that the temperature of both
78      !!         precipitations and runoffs is equal to the SST, thus there
79      !!         is no additional flux since in this case, the concentration
80      !!         dilution effect is balanced by the net heat flux associated
81      !!         to the freshwater exchange (Fwe+Fwi=0):
82      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
83      !!            - salinity    : evaporation, precipitation and runoff
84      !!         water has a zero salinity (Fwe=0), thus only Fwi remains:
85      !!            sa = sa + emp * sn / e3t   for k=1
86      !!         where emp, the surface freshwater budget (evaporation minus
87      !!         precipitation minus runoff) given in kg/m2/s is divided
88      !!         by 1035 kg/m3 (density of ocena water) to obtain m/s.   
89      !!         Note: even though Fwe does not appear explicitly for
90      !!         temperature in this routine, the heat carried by the water
91      !!         exchanged through the surface is part of the total heat flux
92      !!         forcing and must be taken into account in the global heat
93      !!         balance).
94      !!      * nonlinear free surface (variable volume, lk_vvl)
95      !!         contrary to the linear free surface case, Fwi is properly
96      !!         taken into account by using the true layer thicknesses to       
97      !!         calculate tracer content and advection. There is no need to
98      !!         deal with it in this routine.
99      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
100      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
101      !!
102      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
103      !!                with the tracer surface boundary condition
104      !!              - save the trend it in ttrd ('key_trdtra')
105      !!----------------------------------------------------------------------
106      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
107      !!
108      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
109      REAL(wp) ::   zfact, z1_e3t, zsrau, zdep
110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
111      !!----------------------------------------------------------------------
112
113      IF( kt == nit000 ) THEN
114         IF(lwp) WRITE(numout,*)
115         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
116         IF(lwp) WRITE(numout,*) '~~~~~~~ '
117      ENDIF
118
119      zsrau = 1. / rau0             ! initialization
120
121      IF( l_trdtra )   THEN                    !* Save ta and sa trends
122         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
123         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
124      ENDIF
125
126!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
127      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
128         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
129         qsr(:,:) = 0.e0                     ! qsr set to zero
130      ENDIF
131
132      !----------------------------------------
133      !        EMP, EMPS and QNS effects
134      !----------------------------------------
135      !                                          Set before sbc tracer content fields
136      !                                          ************************************
137      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
138         !                                         ! -----------------------------------
139         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
140              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
141            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
142            zfact = 0.5e0
143            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
144            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
145         ELSE                                         ! No restart or restart not found: Euler forward time stepping
146            zfact = 1.e0
147            sbc_tsc_b(:,:,:) = 0.e0
148         ENDIF
149      ELSE                                         ! Swap of forcing fields
150         !                                         ! ----------------------
151         zfact = 0.5e0
152         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
153      ENDIF
154      !                                          Compute now sbc tracer content fields
155      !                                          *************************************
156
157                                                   ! Concentration dilution effect on (t,s) due to 
158                                                   ! evaporation, precipitation and qns, but not river runoff
159                                               
160      IF( lk_vvl ) THEN                            ! Variable Volume case
161         DO jj = 2, jpj
162            DO ji = fs_2, fs_jpim1   ! vector opt.
163               ! temperature : heat flux + cooling/heating effet of EMP flux
164               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
165               ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration
166               sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal)
167            END DO
168         END DO
169      ELSE                                         ! Constant Volume case
170         DO jj = 2, jpj
171            DO ji = fs_2, fs_jpim1   ! vector opt.
172               ! temperature : heat flux
173               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj)
174               ! salinity    : salt flux + concent./dilut. effect (both in emps)
175               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal)
176            END DO
177         END DO
178      ENDIF
179      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff 
180      DO jn = 1, jpts
181         DO jj = 2, jpj
182            DO ji = fs_2, fs_jpim1   ! vector opt.
183               z1_e3t = zfact / fse3t(ji,jj,1)
184               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
185            END DO
186         END DO
187      END DO
188      !                                          Write in the ocean restart file
189      !                                          *******************************
190      IF( lrst_oce ) THEN
191         IF(lwp) WRITE(numout,*)
192         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
193            &                    'at it= ', kt,' date= ', ndastp
194         IF(lwp) WRITE(numout,*) '~~~~'
195         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
196         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
197      ENDIF
198      !
199      !----------------------------------------
200      !        River Runoff effects
201      !----------------------------------------
202      !
203      zfact = 0.5e0
204
205      ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection)
206      IF( ln_rnf ) THEN 
207         DO jj = 2, jpj 
208            DO ji = fs_2, fs_jpim1
209               zdep = 1. / h_rnf(ji,jj)
210               zdep = zfact * zdep 
211               IF ( rnf(ji,jj) /= 0._wp ) THEN
212                  DO jk = 1, nk_rnf(ji,jj)
213                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
214                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
215                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
216                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
217                  END DO
218               ENDIF
219            END DO 
220         END DO 
221      ENDIF 
222!!gm  It should be useless
223      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
224
225      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
226         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
227         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
228         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt )
229         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds )
230         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
231      ENDIF
232      !
233      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
234         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
235      !
236   END SUBROUTINE tra_sbc
237
238   !!======================================================================
239END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.