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.
traqsr.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMO/OPA_SRC/TRA/traqsr.F90 @ 473

Last change on this file since 473 was 457, checked in by opalod, 18 years ago

nemo_v1_update_049:RB: reorganization of tracers part, remove traadv_cen2_atsk.h90 traldf_iso_zps.F90 trazdf_iso.F90 trazdf_iso_vopt.F90, change atsk routines to jki
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.2 KB
Line 
1MODULE traqsr
2   !!======================================================================
3   !!                       ***  MODULE  traqsr  ***
4   !! Ocean physics: solar radiation penetration in the top ocean levels
5   !!======================================================================
6   !! History :
7   !!   6.0  !  90-10  (B. Blanke)  Original code
8   !!   7.0  !  91-11  (G. Madec)
9   !!        !  96-01  (G. Madec)  s-coordinates
10   !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
11   !!   9.0  !  04-08  (C. Talandier) New trends organization
12   !!   9.0  !  05-11  (G. Madec) zco, zps, sco coordinate
13   !!----------------------------------------------------------------------
14   !!   tra_qsr      : trend due to the solar radiation penetration
15   !!   tra_qsr_init : solar radiation penetration initialization
16   !!----------------------------------------------------------------------
17   !! * Modules used
18   USE oce             ! ocean dynamics and active tracers
19   USE dom_oce         ! ocean space and time domain
20   USE trdmod          ! ocean active tracers trends
21   USE trdmod_oce      ! ocean variables trends
22   USE in_out_manager  ! I/O manager
23   USE trc_oce         ! share SMS/Ocean variables
24   USE ocesbc          ! thermohaline fluxes
25   USE phycst          ! physical constants
26   USE prtctl          ! Print control
27
28   IMPLICIT NONE
29   PRIVATE
30
31   !! * Routine accessibility
32   PUBLIC tra_qsr      ! routine called by step.F90 (ln_traqsr=T)
33   PUBLIC tra_qsr_init ! routine called by opa.F90
34
35   !! * Shared module variables
36   LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T)
37
38   !! * Module variables
39   REAL(wp), PUBLIC ::  & !!! * penetrative solar radiation namelist *
40      rabs = 0.58_wp,   &  ! fraction associated with xsi1
41      xsi1 = 0.35_wp,   &  ! first depth of extinction
42      xsi2 = 23.0_wp       ! second depth of extinction
43      !                    ! (default values: water type Ib)
44   LOGICAL ::           & 
45      ln_qsr_sms = .false. ! flag to use or not the biological
46      !                    ! fluxes for light
47   
48   INTEGER ::    &
49      nksr                 ! number of levels
50   REAL(wp), DIMENSION(jpk) ::   &
51      gdsr                 ! profile of the solar flux penetration
52
53   !! * Substitutions
54#  include "domzgr_substitute.h90"
55#  include "vectopt_loop_substitute.h90"
56   !!----------------------------------------------------------------------
57   !!   OPA 9.0 , LOCEAN-IPSL (2005)
58   !! $Header$
59   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
60   !!----------------------------------------------------------------------
61
62CONTAINS
63
64   SUBROUTINE tra_qsr( kt )
65      !!----------------------------------------------------------------------
66      !!                  ***  ROUTINE tra_qsr  ***
67      !!
68      !! ** Purpose :   Compute the temperature trend due to the solar radiation
69      !!      penetration and add it to the general temperature trend.
70      !!
71      !! ** Method  : The profile of the solar radiation within the ocean is
72      !!      defined through two penetration length scale (xsr1,xsr2) and a
73      !!      ratio (rabs) as :
74      !!         I(k) = Qsr*( rabs*EXP(z(k)/xsr1) + (1.-rabs)*EXP(z(k)/xsr2) )
75      !!         The temperature trend associated with the solar radiation
76      !!      penetration is given by :
77      !!            zta = 1/e3t dk[ I ] / (rau0*Cp)
78      !!         At the bottom, boudary condition for the radiation is no flux :
79      !!      all heat which has not been absorbed in the above levels is put
80      !!      in the last ocean level.
81      !!         In z-coordinate case, the computation is only done down to the
82      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients
83      !!      used for the computation are calculated one for once as they
84      !!      depends on k only.
85      !!
86      !! ** Action  : - update ta with the penetrative solar radiation trend
87      !!              - save the trend in ttrd ('key_trdtra')
88      !!
89      !!----------------------------------------------------------------------
90      !! * Modules used     
91      USE oce, ONLY :    ztrdt => ua,   & ! use ua as 3D workspace   
92                         ztrds => va      ! use va as 3D workspace   
93
94      !! * Arguments
95      INTEGER, INTENT( in ) ::   kt       ! ocean time-step
96
97      !! * Local declarations
98      INTEGER ::    ji, jj, jk            ! dummy loop indexes
99      REAL(wp) ::   zc0 , zta             ! temporary scalars
100      !!----------------------------------------------------------------------
101
102      IF( kt == nit000 ) THEN
103         IF ( lwp )  WRITE(numout,*)
104         IF ( lwp )  WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
105         IF ( lwp )  WRITE(numout,*) '~~~~~~~'
106         CALL tra_qsr_init
107      ENDIF
108
109      ! Save ta and sa trends
110      IF( l_trdtra )   THEN
111         ztrdt(:,:,:) = ta(:,:,:) 
112         ztrds(:,:,:) = 0.e0
113      ENDIF
114
115      ! ---------------------------------------------- !
116      !  Biological fluxes  : all vertical coordinate  !
117      ! ---------------------------------------------- !
118      IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN     
119         !                                                   ! ===============
120         DO jk = 1, jpkm1                                    ! Horizontal slab
121            !                                                ! ===============
122            DO jj = 2, jpjm1
123               DO ji = fs_2, fs_jpim1   ! vector opt.
124                 
125                  zc0 = ro0cpr  / fse3t(ji,jj,jk)         ! compute the qsr trend
126                  zta = zc0 * ( etot3(ji,jj,jk  ) * tmask(ji,jj,jk)     &
127                     &        - etot3(ji,jj,jk+1) * tmask(ji,jj,jk+1) )
128                 
129                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta       ! add qsr trend to the temperature trend
130                 
131               END DO
132            END DO
133            !                                                ! ===============
134         END DO                                              !   End of slab
135         !                                                   ! ===============
136
137      ! ---------------------------------------------- !
138      !  Ocean alone :
139      ! ---------------------------------------------- !
140      ELSE
141         !                                                ! =================== !
142         IF( ln_sco ) THEN                                !    s-coordinate     !
143            !                                             ! =================== !
144            DO jk = 1, jpkm1
145               ta(:,:,jk) = ta(:,:,jk) + etot3(:,:,jk) * qsr(:,:)
146            END DO
147         ENDIF
148         !                                                ! =================== !
149         IF( ln_zps ) THEN                                !    partial steps    !
150            !                                             ! =================== !
151            DO jk = 1, nksr
152               DO jj = 2, jpjm1
153                  DO ji = fs_2, fs_jpim1   ! vector opt.
154                     ! qsr trend from gdsr
155                     zc0 = qsr(ji,jj) / fse3t(ji,jj,jk)
156                     zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) )
157                     ! add qsr trend to the temperature trend
158                     ta(ji,jj,jk) = ta(ji,jj,jk) + zta
159                  END DO
160               END DO
161            END DO
162         ENDIF
163         !                                                ! =================== !
164         IF( ln_zco ) THEN                                !     z-coordinate    !
165            !                                             ! =================== !
166            DO jk = 1, nksr
167               zc0 = 1. / e3t_0(jk)
168               DO jj = 2, jpjm1
169                  DO ji = fs_2, fs_jpim1   ! vector opt.
170                     ! qsr trend
171                     zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) )
172                     ! add qsr trend to the temperature trend
173                     ta(ji,jj,jk) = ta(ji,jj,jk) + zta     
174                  END DO
175               END DO
176            END DO
177         ENDIF
178         !
179      ENDIF
180
181      ! qsr tracers trends saved the trends for diagnostics
182      IF( l_trdtra )   THEN
183         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
184         CALL trd_mod( ztrdt, ztrds, jpttdqsr, 'TRA', kt )
185      ENDIF
186
187      !                       ! print mean trends (used for debugging)
188      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
189
190   END SUBROUTINE tra_qsr
191
192
193   SUBROUTINE tra_qsr_init
194      !!----------------------------------------------------------------------
195      !!                  ***  ROUTINE tra_qsr_init  ***
196      !!
197      !! ** Purpose :   Initialization for the penetrative solar radiation
198      !!
199      !! ** Method  :   The profile of solar radiation within the ocean is set
200      !!      from two length scale of penetration (xsr1,xsr2) and a ratio
201      !!      (rabs). These parameters are read in the namqsr namelist. The
202      !!      default values correspond to clear water (type I in Jerlov'
203      !!      (1968) classification.
204      !!         called by tra_qsr at the first timestep (nit000)
205      !!
206      !! ** Action  : - initialize xsr1, xsr2 and rabs
207      !!
208      !! Reference :
209      !!   Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
210      !!----------------------------------------------------------------------
211      INTEGER ::    ji,jj,jk, &  ! dummy loop index
212                    indic        ! temporary integer
213      REAL(wp) ::   zc0 , zc1 , zc2 ,   & ! temporary scalars
214         &          zcst, zdp1, zdp2      !    "         "
215
216      NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms
217      !!----------------------------------------------------------------------
218
219      ! Read Namelist namqsr : ratio and length of penetration
220      ! --------------------
221      REWIND ( numnam )
222      READ   ( numnam, namqsr )
223
224      ! Parameter control and print
225      ! ---------------------------
226      IF( ln_traqsr  ) THEN
227         IF(lwp) THEN
228            WRITE(numout,*)
229            WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
230            WRITE(numout,*) '~~~~~~~~~~~~'
231            WRITE(numout,*) '    Namelist namqsr : set the parameter of penetration'
232            WRITE(numout,*) '        fraction associated with xsi     rabs        = ',rabs
233            WRITE(numout,*) '        first depth of extinction        xsi1        = ',xsi1
234            WRITE(numout,*) '        second depth of extinction       xsi2        = ',xsi2
235            IF( lk_qsr_sms ) THEN
236               WRITE(numout,*) '     Biological fluxes for light(Y/N) ln_qsr_sms  = ',ln_qsr_sms
237            ENDIF
238         ENDIF
239      ELSE
240         IF(lwp) THEN
241            WRITE(numout,*)
242            WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
243            WRITE(numout,*) '~~~~~~~~~~~~'
244         ENDIF
245      ENDIF
246
247      IF( rabs > 1.e0 .OR. rabs < 0.e0 .OR. xsi1 < 0.e0 .OR. xsi2 < 0.e0 ) THEN
248         IF(lwp) WRITE(numout,cform_err)
249         IF(lwp) WRITE(numout,*) '             0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied'
250         nstop = nstop + 1
251      ENDIF
252
253
254      ! Initialization of gdsr
255      ! ----------------------
256      IF( ln_zco .OR. ln_zps ) THEN
257
258         ! z-coordinate with or without partial step : same w-level everywhere inside the ocean
259         gdsr(:) = 0.e0
260         DO jk = 1, jpk
261            zdp1 = -gdepw_0(jk)
262            gdsr(jk) = ro0cpr * (  rabs  * EXP( zdp1/xsi1 ) + (1.-rabs) * EXP( zdp1/xsi2 )  )
263            IF ( gdsr(jk) <= 1.e-10 ) EXIT
264         END DO
265         indic = 0
266         DO jk = 1, jpk
267            IF( gdsr(jk) <= 1.e-15 .AND. indic == 0 ) THEN
268               gdsr(jk) = 0.e0
269               nksr = jk
270               indic = 1
271            ENDIF
272         END DO
273         nksr = MIN( nksr, jpkm1 )
274         IF(lwp) THEN
275            WRITE(numout,*)
276            WRITE(numout,*) '        - z-coordinate, level max of computation =', nksr
277            WRITE(numout,*) '             profile of coef. of penetration:'
278            WRITE(numout,"('              ',7e11.2)") ( gdsr(jk), jk = 1, nksr )
279            WRITE(numout,*)
280         ENDIF
281         ! Initialisation of Biological fluxes for light here because
282         ! the optical biological model is call after the dynamical one
283         IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN
284            DO jk = 1, jpkm1
285               zcst = gdsr(jk) / ro0cpr
286               etot3(:,:,jk) = qsr(:,:) * zcst * tmask(:,:,jk) 
287            END DO
288         ENDIF
289
290      ENDIF
291
292      ! Initialisation of etot3 (s-coordinate)
293      ! -----------------------
294      IF( ln_sco ) THEN
295         etot3(:,:,jpk) = 0.e0
296         DO jk = 1, jpkm1
297            DO jj = 1, jpj
298               DO ji = 1, jpi
299                  zdp1 = -fsdepw(ji,jj,jk  )
300                  zdp2 = -fsdepw(ji,jj,jk+1)
301                  zc0  = ro0cpr / fse3t(ji,jj,jk)
302                  zc1  =   (  rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2)  )
303                  zc2  = - (  rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2)  )
304                  etot3(ji,jj,jk)  = zc0 * (  zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1)  )
305               END DO
306            END DO
307         END DO
308       ENDIF
309
310   END SUBROUTINE tra_qsr_init
311
312   !!======================================================================
313END MODULE traqsr
Note: See TracBrowser for help on using the repository browser.