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 on Ticket #465 – Attachment – NEMO

Ticket #465: trasbc.F90

File trasbc.F90, 10.5 KB (added by rachel.furner, 14 years ago)
Line 
1MODULE trasbc
2   !!==============================================================================
3   !!                       ***  MODULE  trasbc  ***
4   !! Ocean active tracers:  surface boundary condition
5   !!==============================================================================
6   !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code
7   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface
8   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   tra_sbc      : update the tracer trend at ocean surface
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and active tracers
15   USE sbc_oce         ! surface boundary condition: ocean
16   USE dom_oce         ! ocean space domain variables
17   USE phycst          ! physical constant
18   USE traqsr          ! solar radiation penetration
19   USE trdmod          ! ocean trends
20   USE trdmod_oce      ! ocean variables trends
21   USE in_out_manager  ! I/O manager
22   USE prtctl          ! Print control
23   USE sbcrnf          ! River runoff
24   USE sbcmod          ! ln_rnf
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   tra_sbc    ! routine called by step.F90
30
31   !! * Substitutions
32#  include "domzgr_substitute.h90"
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !!   OPA 9.0 , LOCEAN-IPSL (2005)
36   !! $Id: trasbc.F90 1146 2008-06-25 11:42:56Z rblod $
37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE tra_sbc ( kt )
43      !!----------------------------------------------------------------------
44      !!                  ***  ROUTINE tra_sbc  ***
45      !!                   
46      !! ** Purpose :   Compute the tracer surface boundary condition trend of
47      !!      (flux through the interface, concentration/dilution effect)
48      !!      and add it to the general trend of tracer equations.
49      !!
50      !! ** Method :
51      !!      Following Roullet and Madec (2000), the air-sea flux can be divided
52      !!      into three effects: (1) Fext, external forcing;
53      !!      (2) Fwi, concentration/dilution effect due to water exchanged
54      !!         at the surface by evaporation, precipitations and runoff (E-P-R);
55      !!      (3) Fwe, tracer carried with the water that is exchanged.
56      !!
57      !!      Fext, flux through the air-sea interface for temperature and salt:
58      !!            - temperature : heat flux q (w/m2). If penetrative solar
59      !!         radiation q is only the non solar part of the heat flux, the
60      !!         solar part is added in traqsr.F routine.
61      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
62      !!            - salinity    : no salt flux
63      !!
64      !!      The formulation for Fwb and Fwi vary according to the free
65      !!      surface formulation (linear or variable volume).
66      !!      * Linear free surface
67      !!            The surface freshwater flux modifies the ocean volume
68      !!         and thus the concentration of a tracer and the temperature.
69      !!         First order of the effect of surface freshwater exchange
70      !!         for salinity, it can be neglected on temperature (especially
71      !!         as the temperature of precipitations and runoffs is usually
72      !!         unknown).
73      !!            - temperature : we assume that the temperature of both
74      !!         precipitations and runoffs is equal to the SST, thus there
75      !!         is no additional flux since in this case, the concentration
76      !!         dilution effect is balanced by the net heat flux associated
77      !!         to the freshwater exchange (Fwe+Fwi=0):
78      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
79      !!            - salinity    : evaporation, precipitation and runoff
80      !!         water has a zero salinity (Fwe=0), thus only Fwi remains:
81      !!            sa = sa + emp * sn / e3t   for k=1
82      !!         where emp, the surface freshwater budget (evaporation minus
83      !!         precipitation minus runoff) given in kg/m2/s is divided
84      !!         by 1000 kg/m3 (density of plain water) to obtain m/s.   
85      !!         Note: even though Fwe does not appear explicitly for
86      !!         temperature in this routine, the heat carried by the water
87      !!         exchanged through the surface is part of the total heat flux
88      !!         forcing and must be taken into account in the global heat
89      !!         balance).
90      !!      * nonlinear free surface (variable volume, lk_vvl)
91      !!         contrary to the linear free surface case, Fwi is properly
92      !!         taken into account by using the true layer thicknesses to       
93      !!         calculate tracer content and advection. There is no need to
94      !!         deal with it in this routine.
95      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
96      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
97      !!
98      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
99      !!                with the tracer surface boundary condition
100      !!              - save the trend it in ttrd ('key_trdtra')
101      !!----------------------------------------------------------------------
102      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
103      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
104      !!
105      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
106      !!
107      INTEGER  ::   ji, jj, jk           ! dummy loop indices
108      REAL(wp) ::   zta, zsa             ! temporary scalars, adjustment to temperature and salinity
109      REAL(wp) ::   zsrau, zse3t, zdep   ! temporary scalars, 1/density, 1/height of box, 1/height of effected water column
110      REAL(wp) ::   dheat, dsalt          ! total change of temperature and salinity
111      REAL(wp) ::   tot_sal1, tot_tmp1
112      !!----------------------------------------------------------------------
113
114      IF( kt == nit000 ) THEN
115         IF(lwp) WRITE(numout,*)
116         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
117         IF(lwp) WRITE(numout,*) '~~~~~~~ '
118      ENDIF
119
120      zsrau = 1. / rauw             ! initialization
121#if defined key_zco
122      zse3t = 1. / e3t_0(1)
123#endif
124
125      IF( l_trdtra ) THEN           ! Save ta and sa trends
126         ztrdt(:,:,:) = ta(:,:,:) 
127         ztrds(:,:,:) = sa(:,:,:) 
128      ENDIF
129
130      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
131
132      ! Concentration dillution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff
133      DO jj = 2, jpj
134         DO ji = fs_2, fs_jpim1   ! vector opt.
135#if ! defined key_zco
136            zse3t = 1. / fse3t(ji,jj,1)
137#endif
138            IF( lk_vvl) THEN   
139               zta = ro0cpr * qns(ji,jj) * zse3t &                   ! temperature : heat flux
140                &    - emp(ji,jj) * zsrau * tn(ji,jj,1) * zse3t      ! & cooling/heating effet of EMP flux
141               zsa = 0.e0                                            ! No salinity concent./dilut. effect
142            ELSE
143               zta = ro0cpr * qns(ji,jj) * zse3t                     ! temperature : heat flux
144               zsa = emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t     ! salinity :  concent./dilut. effect
145            ENDIF
146            ta(ji,jj,1) = ta(ji,jj,1) + zta                          ! add the trend to the general tracer trend
147            sa(ji,jj,1) = sa(ji,jj,1) + zsa
148         END DO
149      END DO
150
151      IF ( ln_rnf ) THEN
152      ! Concentration / dilution effect on (t,s) due to river runoff
153        DO jj=1,jpj
154           DO ji=1,jpi
155              rnf_dep(ji,jj)=0
156              DO jk=1,rnf_mod_dep(ji,jj)                          ! recalculates rnf_dep to be the depth
157                rnf_dep(ji,jj)=rnf_dep(ji,jj)+fse3t(ji,jj,jk)    ! in metres to the bottom of the relevant grid box
158              ENDDO
159              zdep = 1. / rnf_dep(ji,jj)
160              zse3t= 1. / fse3t(ji,jj,1)
161              IF ( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj)=tn(ji,jj,1)        ! if not specified set runoff temp to be sst
162
163              IF ( rnf(ji,jj) .gt. 0.0 ) THEN
164
165                IF( lk_vvl) THEN
166                  !!!indirect flux, concentration or dilution effect
167                  !!!force a dilution effect in all levels;
168                  dheat=0.0
169                  dsalt=0.0
170                  DO jk=1, rnf_mod_dep(ji,jj)
171                    zta = -tn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep
172                    zsa = -sn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep
173                    ta(ji,jj,jk)=ta(ji,jj,jk)+zta
174                    sa(ji,jj,jk)=sa(ji,jj,jk)+zsa
175                    dheat=dheat+zta*fse3t(ji,jj,jk)
176                    dsalt=dsalt+zsa*fse3t(ji,jj,jk)
177                  ENDDO
178                  !!!negate this total change in heat and salt content from top level
179                  zta=-dheat*zse3t
180                  zsa=-dsalt*zse3t
181                  ta(ji,jj,1)=ta(ji,jj,1)+zta
182                  sa(ji,jj,1)=sa(ji,jj,1)+zsa
183 
184                  !!!direct flux
185                  zta = rnf_tmp(ji,jj) * rnf(ji,jj) * zsrau * zdep
186                  zsa = rnf_sal(ji,jj) * rnf(ji,jj) * zsrau * zdep
187 
188                  DO jk=1, rnf_mod_dep(ji,jj)
189                    ta(ji,jj,jk) = ta(ji,jj,jk) + zta
190                    sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
191                  ENDDO
192 
193                ELSE
194                  DO jk=1, rnf_mod_dep(ji,jj)
195                    zta = ( rnf_tmp(ji,jj)-tn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep
196                    zsa = ( rnf_sal(ji,jj)-sn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep
197                    ta(ji,jj,jk) = ta(ji,jj,jk) + zta
198                    sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
199                  ENDDO
200                ENDIF
201
202              ENDIF
203
204           ENDDO
205        ENDDO
206     
207      ENDIF
208
209      IF( l_trdtra ) THEN      ! save the sbc trends for diagnostic
210         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
211         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
212         CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt)
213      ENDIF
214      !
215      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc  - Ta: ', mask1=tmask,   &
216         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
217      !
218   END SUBROUTINE tra_sbc
219
220   !!======================================================================
221END MODULE trasbc