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

source: branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 @ 6225

Last change on this file since 6225 was 6225, checked in by jamesharle, 8 years ago

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

  • Property svn:keywords set to Id
File size: 21.0 KB
Line 
1MODULE traqsr
2   !!======================================================================
3   !!                       ***  MODULE  traqsr  ***
4   !! Ocean physics:   solar radiation penetration in the top ocean levels
5   !!======================================================================
6   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
7   !!            7.0  !  1991-11  (G. Madec)
8   !!                 !  1996-01  (G. Madec)  s-coordinates
9   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
10   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate
11   !!            3.2  !  2009-04  (G. Madec & NEMO team)
12   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model
13   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   tra_qsr       : temperature trend due to the penetration of solar radiation
18   !!   tra_qsr_init  : initialization of the qsr penetration
19   !!----------------------------------------------------------------------
20   USE oce            ! ocean dynamics and active tracers
21   USE phycst         ! physical constants
22   USE dom_oce        ! ocean space and time domain
23   USE sbc_oce        ! surface boundary condition: ocean
24   USE trc_oce        ! share SMS/Ocean variables
25   USE trd_oce        ! trends: ocean variables
26   USE trdtra         ! trends manager: tracers
27   !
28   USE in_out_manager ! I/O manager
29   USE prtctl         ! Print control
30   USE iom            ! I/O manager
31   USE fldread        ! read input fields
32   USE restart        ! ocean restart
33   USE lib_mpp        ! MPP library
34   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
35   USE wrk_nemo       ! Memory Allocation
36   USE timing         ! Timing
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
42   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
43
44   !                                 !!* Namelist namtra_qsr: penetrative solar radiation
45   LOGICAL , PUBLIC ::   ln_traqsr    !: light absorption (qsr) flag
46   LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag 
47   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag
48   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag
49   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
50   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
51   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
52   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
53   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
54   !
55   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
56 
57   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
58   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
59   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
60   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
61   !
62   INTEGER  ::   nqsr    ! user choice of the type of light penetration
63   REAL(wp) ::   xsi0r   ! inverse of rn_si0
64   REAL(wp) ::   xsi1r   ! inverse of rn_si1
65   !
66   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
67   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
68
69   !! * Substitutions
70#  include "vectopt_loop_substitute.h90"
71   !!----------------------------------------------------------------------
72   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
73   !! $Id$
74   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
75   !!----------------------------------------------------------------------
76CONTAINS
77
78   SUBROUTINE tra_qsr( kt )
79      !!----------------------------------------------------------------------
80      !!                  ***  ROUTINE tra_qsr  ***
81      !!
82      !! ** Purpose :   Compute the temperature trend due to the solar radiation
83      !!              penetration and add it to the general temperature trend.
84      !!
85      !! ** Method  : The profile of the solar radiation within the ocean is defined
86      !!      through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
87      !!      Considering the 2 wavebands case:
88      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
89      !!         The temperature trend associated with the solar radiation penetration
90      !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp)
91      !!         At the bottom, boudary condition for the radiation is no flux :
92      !!      all heat which has not been absorbed in the above levels is put
93      !!      in the last ocean level.
94      !!         The computation is only done down to the level where
95      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) .
96      !!
97      !! ** Action  : - update ta with the penetrative solar radiation trend
98      !!              - send  trend for further diagnostics (l_trdtra=T)
99      !!
100      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
101      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
102      !!----------------------------------------------------------------------
103      INTEGER, INTENT(in) ::   kt     ! ocean time-step
104      !
105      INTEGER  ::   ji, jj, jk               ! dummy loop indices
106      INTEGER  ::   irgb                     ! local integers
107      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
108      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
109      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
110      REAL(wp) ::   zz0 , zz1                !    -         -
111      REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
112      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
113      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot
114      !!----------------------------------------------------------------------
115      !
116      IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
117      !
118      IF( kt == nit000 ) THEN
119         IF(lwp) WRITE(numout,*)
120         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
121         IF(lwp) WRITE(numout,*) '~~~~~~~'
122      ENDIF
123      !
124      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
125         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
126         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
127      ENDIF
128      !
129      !                         !-----------------------------------!
130      !                         !  before qsr induced heat content  !
131      !                         !-----------------------------------!
132      IF( kt == nit000 ) THEN          !==  1st time step  ==!
133!!gm case neuler  not taken into account....
134         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
135            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
136            z1_2 = 0.5_wp
137            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
138         ELSE                                           ! No restart or restart not found: Euler forward time stepping
139            z1_2 = 1._wp
140            qsr_hc_b(:,:,:) = 0._wp
141         ENDIF
142      ELSE                             !==  Swap of qsr heat content  ==!
143         z1_2 = 0.5_wp
144         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
145      ENDIF
146      !
147      !                         !--------------------------------!
148      SELECT CASE( nqsr )       !  now qsr induced heat content  !
149      !                         !--------------------------------!
150      !
151      CASE( np_BIO )                   !==  bio-model fluxes  ==!
152         !
153         DO jk = 1, nksr
154            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
155         END DO
156         !
157      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
158         !
159         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
160         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea ) 
161         !
162         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
163            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
164            DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
165               DO ji = fs_2, fs_jpim1
166                  zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
167                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
168                  zekb(ji,jj) = rkrgb(1,irgb)
169                  zekg(ji,jj) = rkrgb(2,irgb)
170                  zekr(ji,jj) = rkrgb(3,irgb)
171               END DO
172            END DO
173         ELSE                                !* constant chrlorophyll
174            zchl = 0.05                            ! constant chlorophyll
175            !                                      ! Separation in R-G-B depending of the chlorophyll
176            irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
177            DO jj = 2, jpjm1
178               DO ji = fs_2, fs_jpim1
179                  zekb(ji,jj) = rkrgb(1,irgb)                     
180                  zekg(ji,jj) = rkrgb(2,irgb)
181                  zekr(ji,jj) = rkrgb(3,irgb)
182               END DO
183            END DO
184         ENDIF
185         !
186         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
187         DO jj = 2, jpjm1
188            DO ji = fs_2, fs_jpim1
189               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
190               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
191               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
192               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
193               zea(ji,jj,1) =          qsr(ji,jj)
194            END DO
195         END DO
196         !
197         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B
198            DO jj = 2, jpjm1
199               DO ji = fs_2, fs_jpim1
200                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
201                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
202                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
203                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
204                  ze0(ji,jj,jk) = zc0
205                  ze1(ji,jj,jk) = zc1
206                  ze2(ji,jj,jk) = zc2
207                  ze3(ji,jj,jk) = zc3
208                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
209               END DO
210            END DO
211         END DO
212         !
213         DO jk = 1, nksr                     !* now qsr induced heat content
214            DO jj = 2, jpjm1
215               DO ji = fs_2, fs_jpim1
216                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
217               END DO
218            END DO
219         END DO
220         !
221         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
222         CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea ) 
223         !
224      CASE( np_2BD  )            !==  2-bands fluxes  ==!
225         !
226         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
227         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
228         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m
229            DO jj = 2, jpjm1
230               DO ji = fs_2, fs_jpim1
231                  zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
232                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )
233                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
234               END DO
235            END DO
236         END DO
237         !
238      END SELECT
239      !
240      !                          !-----------------------------!
241      DO jk = 1, nksr            !  update to the temp. trend  !
242         DO jj = 2, jpjm1        !-----------------------------!
243            DO ji = fs_2, fs_jpim1   ! vector opt.
244               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
245                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
246            END DO
247         END DO
248      END DO
249      !
250      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient
251         DO jj = 2, jpjm1 
252            DO ji = fs_2, fs_jpim1   ! vector opt.
253               IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
254               ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
255               ENDIF
256            END DO
257         END DO
258         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
259         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
260      ENDIF
261      !
262      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
263         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
264         !
265         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
266         DO jk = nksr, 1, -1
267            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
268         END DO         
269         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
270         !
271         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
272      ENDIF
273      !
274      IF( lrst_oce ) THEN     ! write in the ocean restart file
275         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
276         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 
277      ENDIF
278      !
279      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
280         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
281         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
282         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
283      ENDIF
284      !                       ! print mean trends (used for debugging)
285      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
286      !
287      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
288      !
289   END SUBROUTINE tra_qsr
290
291
292   SUBROUTINE tra_qsr_init
293      !!----------------------------------------------------------------------
294      !!                  ***  ROUTINE tra_qsr_init  ***
295      !!
296      !! ** Purpose :   Initialization for the penetrative solar radiation
297      !!
298      !! ** Method  :   The profile of solar radiation within the ocean is set
299      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
300      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
301      !!      default values correspond to clear water (type I in Jerlov'
302      !!      (1968) classification.
303      !!         called by tra_qsr at the first timestep (nit000)
304      !!
305      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
306      !!
307      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
308      !!----------------------------------------------------------------------
309      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
310      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
311      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
312      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
313      !
314      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
315      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
316      !!
317      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
318         &                  nn_chldta, rn_abs, rn_si0, rn_si1
319      !!----------------------------------------------------------------------
320      !
321      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
322      !
323      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
324      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
325901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
326      !
327      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
328      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
329902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
330      IF(lwm) WRITE ( numond, namtra_qsr )
331      !
332      IF(lwp) THEN                ! control print
333         WRITE(numout,*)
334         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
335         WRITE(numout,*) '~~~~~~~~~~~~'
336         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
337         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
338         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
339         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
340         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
341         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
342         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
343         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
344         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
345         WRITE(numout,*)
346      ENDIF
347      !
348      ioptio = 0                    ! Parameter control
349      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
350      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
351      IF( ln_qsr_bio  )   ioptio = ioptio + 1
352      !
353      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
354         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
355      !
356      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
357      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
358      IF( ln_qsr_2bd                      )   nqsr = np_2BD
359      IF( ln_qsr_bio                      )   nqsr = np_BIO
360      !
361      !                             ! Initialisation
362      xsi0r = 1._wp / rn_si0
363      xsi1r = 1._wp / rn_si1
364      !
365      SELECT CASE( nqsr )
366      !                               
367      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
368         !                             
369         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
370         !
371         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
372         !                                   
373         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
374         !
375         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
376         !
377         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
378            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
379            ALLOCATE( sf_chl(1), STAT=ierror )
380            IF( ierror > 0 ) THEN
381               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
382            ENDIF
383            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
384            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
385            !                                        ! fill sf_chl with sn_chl and control print
386            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
387               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' )
388         ENDIF
389         IF( nqsr == np_RGB ) THEN                 ! constant Chl
390            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
391         ENDIF
392         !
393      CASE( np_2BD )                   !==  2 bands light penetration  ==!
394         !
395         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
396         !
397         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
398         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
399         !
400      CASE( np_BIO )                   !==  BIO light penetration  ==!
401         !
402         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
403         IF( .NOT.lk_qsr_bio )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
404         !
405      END SELECT
406      !
407      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
408      !
409      ! 1st ocean level attenuation coefficient (used in sbcssm)
410      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
411         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
412      ELSE
413         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
414      ENDIF
415      !
416      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
417      !
418   END SUBROUTINE tra_qsr_init
419
420   !!======================================================================
421END MODULE traqsr
Note: See TracBrowser for help on using the repository browser.