source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traqsr.F90 @ 10806

Last change on this file since 10806 was 10806, checked in by davestorkey, 2 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps branch: Latest updates. Make sure all time-dependent 3D variables are converted in previously modified modules.

  • Property svn:keywords set to Id
File size: 22.3 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 "vectopt_loop_substitute.h90"
70   !!----------------------------------------------------------------------
71   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
72   !! $Id$
73   !! Software governed by the CeCILL license (see ./LICENSE)
74   !!----------------------------------------------------------------------
75CONTAINS
76
77   SUBROUTINE tra_qsr( kt, ktlev, kt2lev, pts_rhs )
78      !!----------------------------------------------------------------------
79      !!                  ***  ROUTINE tra_qsr  ***
80      !!
81      !! ** Purpose :   Compute the temperature trend due to the solar radiation
82      !!              penetration and add it to the general temperature trend.
83      !!
84      !! ** Method  : The profile of the solar radiation within the ocean is defined
85      !!      through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
86      !!      Considering the 2 wavebands case:
87      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
88      !!         The temperature trend associated with the solar radiation penetration
89      !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp)
90      !!         At the bottom, boudary condition for the radiation is no flux :
91      !!      all heat which has not been absorbed in the above levels is put
92      !!      in the last ocean level.
93      !!         The computation is only done down to the level where
94      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) .
95      !!
96      !! ** Action  : - update ta with the penetrative solar radiation trend
97      !!              - send  trend for further diagnostics (l_trdtra=T)
98      !!
99      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
100      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
101      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
102      !!----------------------------------------------------------------------
103      INTEGER, INTENT(in) ::   kt     ! ocean time-step
104      INTEGER, INTENT(in) ::   ktlev  ! time level index for 3-time-level source terms
105      INTEGER, INTENT(in) ::   kt2lev ! time level index for 2-time-level source terms
106      REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends
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_rhs(:,:,:,jp_tem)
132      ENDIF
133      !
134      !                         !-----------------------------------!
135      !                         !  before qsr induced heat content  !
136      !                         !-----------------------------------!
137      IF( kt == nit000 ) THEN          !==  1st time step  ==!
138!!gm case neuler  not taken into account....
139         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
140            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
141            z1_2 = 0.5_wp
142            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux
143         ELSE                                           ! No restart or restart not found: Euler forward time stepping
144            z1_2 = 1._wp
145            qsr_hc_b(:,:,:) = 0._wp
146         ENDIF
147      ELSE                             !==  Swap of qsr heat content  ==!
148         z1_2 = 0.5_wp
149         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
150      ENDIF
151      !
152      !                         !--------------------------------!
153      SELECT CASE( nqsr )       !  now qsr induced heat content  !
154      !                         !--------------------------------!
155      !
156      CASE( np_BIO )                   !==  bio-model fluxes  ==!
157         !
158         DO jk = 1, nksr
159            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
160         END DO
161         !
162      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
163         !
164         ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , &
165            &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , &
166            &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   ) 
167         !
168         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
169            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
170            DO jk = 1, nksr + 1
171               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
172                  DO ji = fs_2, fs_jpim1
173                     zchl    = sf_chl(1)%fnow(ji,jj,1)
174                     zCtot   = 40.6  * zchl**0.459
175                     zze     = 568.2 * zCtot**(-0.746)
176                     IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
177                     zpsi    = gdepw(ji,jj,jk,kt2lev) / zze
178                     !
179                     zlogc   = LOG( zchl )
180                     zlogc2  = zlogc * zlogc
181                     zlogc3  = zlogc * zlogc * zlogc
182                     zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
183                     zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
184                     zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
185                     zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
186                     zCze    = 1.12  * (zchl)**0.803 
187                     !
188                     zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
189                  END DO
190                  !
191               END DO
192            END DO
193         ELSE                                !* constant chrlorophyll
194           DO jk = 1, nksr + 1
195              zchl3d(:,:,jk) = 0.05 
196            ENDDO
197         ENDIF
198         !
199         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
200         DO jj = 2, jpjm1
201            DO ji = fs_2, fs_jpim1
202               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
203               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
204               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
205               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
206               zea(ji,jj,1) =          qsr(ji,jj)
207            END DO
208         END DO
209         !
210         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
211            DO jj = 2, jpjm1
212               DO ji = fs_2, fs_jpim1
213                  zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
214                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
215                  zekb(ji,jj) = rkrgb(1,irgb)
216                  zekg(ji,jj) = rkrgb(2,irgb)
217                  zekr(ji,jj) = rkrgb(3,irgb)
218               END DO
219            END DO
220
221            DO jj = 2, jpjm1
222               DO ji = fs_2, fs_jpim1
223                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,ktlev) * xsi0r       )
224                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,ktlev) * zekb(ji,jj) )
225                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,ktlev) * zekg(ji,jj) )
226                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,ktlev) * zekr(ji,jj) )
227                  ze0(ji,jj,jk) = zc0
228                  ze1(ji,jj,jk) = zc1
229                  ze2(ji,jj,jk) = zc2
230                  ze3(ji,jj,jk) = zc3
231                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
232               END DO
233            END DO
234         END DO
235         !
236         DO jk = 1, nksr                     !* now qsr induced heat content
237            DO jj = 2, jpjm1
238               DO ji = fs_2, fs_jpim1
239                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
240               END DO
241            END DO
242         END DO
243         !
244         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d ) 
245         !
246      CASE( np_2BD  )            !==  2-bands fluxes  ==!
247         !
248         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
249         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
250         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m
251            DO jj = 2, jpjm1
252               DO ji = fs_2, fs_jpim1
253                  zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,kt2lev)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,kt2lev)*xsi1r )
254                  zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,kt2lev)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,kt2lev)*xsi1r )
255                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
256               END DO
257            END DO
258         END DO
259         !
260      END SELECT
261      !
262      !                          !-----------------------------!
263      DO jk = 1, nksr            !  update to the temp. trend  !
264         DO jj = 2, jpjm1        !-----------------------------!
265            DO ji = fs_2, fs_jpim1   ! vector opt.
266               pts_rhs(ji,jj,jk,jp_tem) = pts_rhs(ji,jj,jk,jp_tem)   &
267                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,ktlev)
268            END DO
269         END DO
270      END DO
271      !
272      ! sea-ice: store the 1st ocean level attenuation coefficient
273      DO jj = 2, jpjm1 
274         DO ji = fs_2, fs_jpim1   ! vector opt.
275            IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
276            ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
277            ENDIF
278         END DO
279      END DO
280      CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp )
281      !
282      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
283         ALLOCATE( zetot(jpi,jpj,jpk) )
284         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
285         DO jk = nksr, 1, -1
286            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp
287         END DO         
288         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
289         DEALLOCATE( zetot ) 
290      ENDIF
291      !
292      IF( lrst_oce ) THEN     ! write in the ocean restart file
293         IF( lwxios ) CALL iom_swap(      cwxios_context          )
294         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc     , ldxios = lwxios )
295         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 
296         IF( lwxios ) CALL iom_swap(      cxios_context          )
297      ENDIF
298      !
299      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
300         ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:)
301         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
302         DEALLOCATE( ztrdt ) 
303      ENDIF
304      !                       ! print mean trends (used for debugging)
305      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
306      !
307      IF( ln_timing )   CALL timing_stop('tra_qsr')
308      !
309   END SUBROUTINE tra_qsr
310
311
312   SUBROUTINE tra_qsr_init
313      !!----------------------------------------------------------------------
314      !!                  ***  ROUTINE tra_qsr_init  ***
315      !!
316      !! ** Purpose :   Initialization for the penetrative solar radiation
317      !!
318      !! ** Method  :   The profile of solar radiation within the ocean is set
319      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
320      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
321      !!      default values correspond to clear water (type I in Jerlov'
322      !!      (1968) classification.
323      !!         called by tra_qsr at the first timestep (nit000)
324      !!
325      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
326      !!
327      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
328      !!----------------------------------------------------------------------
329      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
330      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
331      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
332      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
333      !
334      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
335      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
336      !!
337      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,  &
338         &                  nn_chldta, rn_abs, rn_si0, rn_si1
339      !!----------------------------------------------------------------------
340      !
341      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
342      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
343901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
344      !
345      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
346      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
347902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
348      IF(lwm) WRITE ( numond, namtra_qsr )
349      !
350      IF(lwp) THEN                ! control print
351         WRITE(numout,*)
352         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
353         WRITE(numout,*) '~~~~~~~~~~~~'
354         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
355         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
356         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
357         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
358         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
359         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
360         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
361         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
362         WRITE(numout,*)
363      ENDIF
364      !
365      ioptio = 0                    ! Parameter control
366      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
367      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
368      IF( ln_qsr_bio  )   ioptio = ioptio + 1
369      !
370      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
371         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
372      !
373      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
374      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
375      IF( ln_qsr_2bd                      )   nqsr = np_2BD
376      IF( ln_qsr_bio                      )   nqsr = np_BIO
377      !
378      !                             ! Initialisation
379      xsi0r = 1._wp / rn_si0
380      xsi1r = 1._wp / rn_si1
381      !
382      SELECT CASE( nqsr )
383      !                               
384      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
385         !                             
386         IF(lwp)   WRITE(numout,*) '   ==>>>   R-G-B   light penetration '
387         !
388         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
389         !                                   
390         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
391         !
392         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
393         !
394         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
395            IF(lwp) WRITE(numout,*) '   ==>>>   Chlorophyll read in a file'
396            ALLOCATE( sf_chl(1), STAT=ierror )
397            IF( ierror > 0 ) THEN
398               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
399            ENDIF
400            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
401            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
402            !                                        ! fill sf_chl with sn_chl and control print
403            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
404               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print )
405         ENDIF
406         IF( nqsr == np_RGB ) THEN                 ! constant Chl
407            IF(lwp) WRITE(numout,*) '   ==>>>   Constant Chlorophyll concentration = 0.05'
408         ENDIF
409         !
410      CASE( np_2BD )                   !==  2 bands light penetration  ==!
411         !
412         IF(lwp)  WRITE(numout,*) '   ==>>>   2 bands light penetration'
413         !
414         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
415         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
416         !
417      CASE( np_BIO )                   !==  BIO light penetration  ==!
418         !
419         IF(lwp) WRITE(numout,*) '   ==>>>   bio-model light penetration'
420         IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
421         !
422      END SELECT
423      !
424      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
425      !
426      ! 1st ocean level attenuation coefficient (used in sbcssm)
427      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
428         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  )
429      ELSE
430         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
431      ENDIF
432      !
433      IF( lwxios ) THEN
434         CALL iom_set_rstw_var_active('qsr_hc_b')
435         CALL iom_set_rstw_var_active('fraqsr_1lev')
436      ENDIF
437      !
438   END SUBROUTINE tra_qsr_init
439
440   !!======================================================================
441END MODULE traqsr
Note: See TracBrowser for help on using the repository browser.