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 NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA – NEMO

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traqsr.F90 @ 12724

Last change on this file since 12724 was 12724, checked in by techene, 4 years ago

branch KERNEL-06 : merge with trunk@12698 #2385 - in duplcated files : changes to comply to the new trunk variables and some loop bug fixes
  • Property svn:keywords set to Id
File size: 21.2 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.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
14   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume
15   !!----------------------------------------------------------------------
16
17   !!----------------------------------------------------------------------
18   !!   tra_qsr       : temperature trend due to the penetration of solar radiation
19   !!   tra_qsr_init  : initialization of the qsr penetration
20   !!----------------------------------------------------------------------
21   USE oce            ! ocean dynamics and active tracers
22   USE phycst         ! physical constants
23   USE dom_oce        ! ocean space and time domain
24   USE sbc_oce        ! surface boundary condition: ocean
25   USE trc_oce        ! share SMS/Ocean variables
26   USE trd_oce        ! trends: ocean variables
27   USE trdtra         ! trends manager: tracers
28   !
29   USE in_out_manager ! I/O manager
30   USE prtctl         ! Print control
31   USE iom            ! I/O library
32   USE fldread        ! read input fields
33   USE restart        ! ocean restart
34   USE lib_mpp        ! MPP library
35   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
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   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
50   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
51   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
52   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
53   !
54   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
55
56   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
57   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
58   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
59   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
60   !
61   INTEGER  ::   nqsr    ! user choice of the type of light penetration
62   REAL(wp) ::   xsi0r   ! inverse of rn_si0
63   REAL(wp) ::   xsi1r   ! inverse of rn_si1
64   !
65   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
66   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
67
68   !! * Substitutions
69#  include "do_loop_substitute.h90"
70#  include "domzgr_substitute.h90"
71   !!----------------------------------------------------------------------
72   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
73   !! $Id$
74   !! Software governed by the CeCILL license (see ./LICENSE)
75   !!----------------------------------------------------------------------
76CONTAINS
77
78   SUBROUTINE tra_qsr( kt, Kmm, pts, Krhs )
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 ] / (rho0*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      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
103      !!----------------------------------------------------------------------
104      INTEGER,                                   INTENT(in   ) :: kt            ! ocean time-step
105      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs     ! time level indices
106      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts           ! active tracers and RHS of tracer equation
107      !
108      INTEGER  ::   ji, jj, jk               ! dummy loop indices
109      INTEGER  ::   irgb                     ! local integers
110      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
111      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
112      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
113      REAL(wp) ::   zz0 , zz1                !    -         -
114      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
115      REAL(wp) ::   zlogc, zlogc2, zlogc3
116      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr
117      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
118      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d
119      !!----------------------------------------------------------------------
120      !
121      IF( ln_timing )   CALL timing_start('tra_qsr')
122      !
123      IF( kt == nit000 ) THEN
124         IF(lwp) WRITE(numout,*)
125         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
126         IF(lwp) WRITE(numout,*) '~~~~~~~'
127      ENDIF
128      !
129      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
130         ALLOCATE( ztrdt(jpi,jpj,jpk) )
131         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
132      ENDIF
133      !
134      !                         !-----------------------------------!
135      !                         !  before qsr induced heat content  !
136      !                         !-----------------------------------!
137      IF( kt == nit000 ) THEN          !==  1st time step  ==!
138         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart
139            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
140            z1_2 = 0.5_wp
141            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux
142         ELSE                                           ! No restart or restart not found: Euler forward time stepping
143            z1_2 = 1._wp
144            qsr_hc_b(:,:,:) = 0._wp
145         ENDIF
146      ELSE                             !==  Swap of qsr heat content  ==!
147         z1_2 = 0.5_wp
148         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
149      ENDIF
150      !
151      !                         !--------------------------------!
152      SELECT CASE( nqsr )       !  now qsr induced heat content  !
153      !                         !--------------------------------!
154      !
155      CASE( np_BIO )                   !==  bio-model fluxes  ==!
156         !
157         DO jk = 1, nksr
158            qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
159         END DO
160         !
161      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
162         !
163         ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , &
164            &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , &
165            &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   )
166         !
167         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
168            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
169            DO jk = 1, nksr + 1
170               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
171                  DO ji = 2, jpim1
172                     zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
173                     zCtot   = 40.6  * zchl**0.459
174                     zze     = 568.2 * zCtot**(-0.746)
175                     IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
176                     zpsi    = gdepw(ji,jj,jk,Kmm) / zze
177                     !
178                     zlogc   = LOG( zchl )
179                     zlogc2  = zlogc * zlogc
180                     zlogc3  = zlogc * zlogc * zlogc
181                     zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
182                     zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
183                     zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
184                     zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
185                     zCze    = 1.12  * (zchl)**0.803
186                     !
187                     zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
188                  END DO
189                  !
190               END DO
191            END DO
192         ELSE                                !* constant chrlorophyll
193           DO jk = 1, nksr + 1
194              zchl3d(:,:,jk) = 0.05
195            ENDDO
196         ENDIF
197         !
198         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
199         DO_2D_00_00
200            ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
201            ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
202            ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
203            ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
204            zea(ji,jj,1) =          qsr(ji,jj)
205         END_2D
206         !
207         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
208            DO_2D_00_00
209               zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
210               irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
211               zekb(ji,jj) = rkrgb(1,irgb)
212               zekg(ji,jj) = rkrgb(2,irgb)
213               zekr(ji,jj) = rkrgb(3,irgb)
214            END_2D
215
216            DO_2D_00_00
217               zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       )
218               zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) )
219               zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) )
220               zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) )
221               ze0(ji,jj,jk) = zc0
222               ze1(ji,jj,jk) = zc1
223               ze2(ji,jj,jk) = zc2
224               ze3(ji,jj,jk) = zc3
225               zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
226            END_2D
227         END DO
228         !
229         DO_3D_00_00( 1, nksr )
230            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
231         END_3D
232         !
233         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )
234         !
235      CASE( np_2BD  )            !==  2-bands fluxes  ==!
236         !
237         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands
238         zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
239         DO_3D_00_00( 1, nksr )
240            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r )
241            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
242            qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) )
243         END_3D
244         !
245      END SELECT
246      !
247      !                          !-----------------------------!
248      DO_3D_00_00( 1, nksr )
249         pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
250            &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) )   &
251            &                             / e3t(ji,jj,jk,Kmm)
252      END_3D
253      !
254      ! sea-ice: store the 1st ocean level attenuation coefficient
255      DO_2D_00_00
256         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
257         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
258         ENDIF
259      END_2D
260      CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp )
261      !
262      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
263         ALLOCATE( zetot(jpi,jpj,jpk) )
264         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
265         DO jk = nksr, 1, -1
266            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp
267         END DO
268         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
269         DEALLOCATE( zetot )
270      ENDIF
271      !
272      IF( lrst_oce ) THEN     ! write in the ocean restart file
273         IF( lwxios ) CALL iom_swap(      cwxios_context          )
274         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc     , ldxios = lwxios )
275         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios )
276         IF( lwxios ) CALL iom_swap(      cxios_context          )
277      ENDIF
278      !
279      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
280         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
281         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt )
282         DEALLOCATE( ztrdt )
283      ENDIF
284      !                       ! print mean trends (used for debugging)
285      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
286      !
287      IF( ln_timing )   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,  &
318         &                  nn_chldta, rn_abs, rn_si0, rn_si1
319      !!----------------------------------------------------------------------
320      !
321      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
322901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist' )
323      !
324      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
325902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist' )
326      IF(lwm) WRITE ( numond, namtra_qsr )
327      !
328      IF(lwp) THEN                ! control print
329         WRITE(numout,*)
330         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
331         WRITE(numout,*) '~~~~~~~~~~~~'
332         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
333         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
334         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
335         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
336         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
337         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
338         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
339         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
340         WRITE(numout,*)
341      ENDIF
342      !
343      ioptio = 0                    ! Parameter control
344      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
345      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
346      IF( ln_qsr_bio  )   ioptio = ioptio + 1
347      !
348      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
349         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
350      !
351      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB
352      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
353      IF( ln_qsr_2bd                      )   nqsr = np_2BD
354      IF( ln_qsr_bio                      )   nqsr = np_BIO
355      !
356      !                             ! Initialisation
357      xsi0r = 1._wp / rn_si0
358      xsi1r = 1._wp / rn_si1
359      !
360      SELECT CASE( nqsr )
361      !
362      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
363         !
364         IF(lwp)   WRITE(numout,*) '   ==>>>   R-G-B   light penetration '
365         !
366         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
367         !
368         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
369         !
370         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
371         !
372         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
373            IF(lwp) WRITE(numout,*) '   ==>>>   Chlorophyll read in a file'
374            ALLOCATE( sf_chl(1), STAT=ierror )
375            IF( ierror > 0 ) THEN
376               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
377            ENDIF
378            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
379            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
380            !                                        ! fill sf_chl with sn_chl and control print
381            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
382               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print )
383         ENDIF
384         IF( nqsr == np_RGB ) THEN                 ! constant Chl
385            IF(lwp) WRITE(numout,*) '   ==>>>   Constant Chlorophyll concentration = 0.05'
386         ENDIF
387         !
388      CASE( np_2BD )                   !==  2 bands light penetration  ==!
389         !
390         IF(lwp)  WRITE(numout,*) '   ==>>>   2 bands light penetration'
391         !
392         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
393         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
394         !
395      CASE( np_BIO )                   !==  BIO light penetration  ==!
396         !
397         IF(lwp) WRITE(numout,*) '   ==>>>   bio-model light penetration'
398         IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
399         !
400      END SELECT
401      !
402      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
403      !
404      ! 1st ocean level attenuation coefficient (used in sbcssm)
405      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
406         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  )
407      ELSE
408         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
409      ENDIF
410      !
411      IF( lwxios ) THEN
412         CALL iom_set_rstw_var_active('qsr_hc_b')
413         CALL iom_set_rstw_var_active('fraqsr_1lev')
414      ENDIF
415      !
416   END SUBROUTINE tra_qsr_init
417
418   !!======================================================================
419END MODULE traqsr
Note: See TracBrowser for help on using the repository browser.