source: branches/2017/dev_r8600_xios_write/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 @ 8662

Last change on this file since 8662 was 8662, checked in by andmirek, 3 years ago

#1962 change variable names to follow NEMO coding convention

  • Property svn:keywords set to Id
File size: 22.4 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 manager
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 wrk_nemo       ! Memory Allocation
37   USE timing         ! Timing
38   USE iom_def, ONLY : lwxios
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
44   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
45
46   !                                 !!* Namelist namtra_qsr: penetrative solar radiation
47   LOGICAL , PUBLIC ::   ln_traqsr    !: light absorption (qsr) flag
48   LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag 
49   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag
50   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag
51   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
52   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
53   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
54   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
55   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
56   !
57   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
58 
59   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
60   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
61   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
62   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
63   !
64   INTEGER  ::   nqsr    ! user choice of the type of light penetration
65   REAL(wp) ::   xsi0r   ! inverse of rn_si0
66   REAL(wp) ::   xsi1r   ! inverse of rn_si1
67   !
68   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
69   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
70
71   !! * Substitutions
72#  include "vectopt_loop_substitute.h90"
73   !!----------------------------------------------------------------------
74   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
75   !! $Id$
76   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
77   !!----------------------------------------------------------------------
78CONTAINS
79
80   SUBROUTINE tra_qsr( kt )
81      !!----------------------------------------------------------------------
82      !!                  ***  ROUTINE tra_qsr  ***
83      !!
84      !! ** Purpose :   Compute the temperature trend due to the solar radiation
85      !!              penetration and add it to the general temperature trend.
86      !!
87      !! ** Method  : The profile of the solar radiation within the ocean is defined
88      !!      through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
89      !!      Considering the 2 wavebands case:
90      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
91      !!         The temperature trend associated with the solar radiation penetration
92      !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp)
93      !!         At the bottom, boudary condition for the radiation is no flux :
94      !!      all heat which has not been absorbed in the above levels is put
95      !!      in the last ocean level.
96      !!         The computation is only done down to the level where
97      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) .
98      !!
99      !! ** Action  : - update ta with the penetrative solar radiation trend
100      !!              - send  trend for further diagnostics (l_trdtra=T)
101      !!
102      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
103      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
104      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
105      !!----------------------------------------------------------------------
106      INTEGER, INTENT(in) ::   kt     ! ocean time-step
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), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
117      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
118      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d
119      !!----------------------------------------------------------------------
120      !
121      IF( nn_timing == 1 )  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         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
131         ztrdt(:,:,:) = tsa(:,:,:,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 )   ! 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         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
165         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
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 = fs_2, fs_jpim1
172                     zchl    = 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_n(ji,jj,jk) / 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 jj = 2, jpjm1
200            DO ji = fs_2, fs_jpim1
201               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
202               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
203               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
204               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
205               zea(ji,jj,1) =          qsr(ji,jj)
206            END DO
207         END DO
208         !
209         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
210            DO jj = 2, jpjm1
211               DO ji = fs_2, fs_jpim1
212                  zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
213                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
214                  zekb(ji,jj) = rkrgb(1,irgb)
215                  zekg(ji,jj) = rkrgb(2,irgb)
216                  zekr(ji,jj) = rkrgb(3,irgb)
217               END DO
218            END DO
219
220            DO jj = 2, jpjm1
221               DO ji = fs_2, fs_jpim1
222                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
223                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
224                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
225                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
226                  ze0(ji,jj,jk) = zc0
227                  ze1(ji,jj,jk) = zc1
228                  ze2(ji,jj,jk) = zc2
229                  ze3(ji,jj,jk) = zc3
230                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
231               END DO
232            END DO
233         END DO
234         !
235         DO jk = 1, nksr                     !* now qsr induced heat content
236            DO jj = 2, jpjm1
237               DO ji = fs_2, fs_jpim1
238                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
239               END DO
240            END DO
241         END DO
242         !
243         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
244         CALL wrk_dealloc( jpi,jpj,jpk,   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_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
254                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*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               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
267                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
268            END DO
269         END DO
270      END DO
271      !
272      IF( ln_qsr_ice ) THEN      ! 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         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
281         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
282      ENDIF
283      !
284      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
285         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
286         !
287         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
288         DO jk = nksr, 1, -1
289            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
290         END DO         
291         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
292         !
293         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
294      ENDIF
295      !
296      IF( lrst_oce ) THEN     ! write in the ocean restart file
297         IF( lwxios ) CALL iom_swap(      wxios_context          )
298         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc, ldxios = lwxios      )
299         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 
300         IF( lwxios ) CALL iom_swap(      cxios_context          )
301      ENDIF
302      !
303      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
304         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
305         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
306         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
307      ENDIF
308      !                       ! print mean trends (used for debugging)
309      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
310      !
311      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
312      !
313   END SUBROUTINE tra_qsr
314
315
316   SUBROUTINE tra_qsr_init
317      !!----------------------------------------------------------------------
318      !!                  ***  ROUTINE tra_qsr_init  ***
319      !!
320      !! ** Purpose :   Initialization for the penetrative solar radiation
321      !!
322      !! ** Method  :   The profile of solar radiation within the ocean is set
323      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
324      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
325      !!      default values correspond to clear water (type I in Jerlov'
326      !!      (1968) classification.
327      !!         called by tra_qsr at the first timestep (nit000)
328      !!
329      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
330      !!
331      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
332      !!----------------------------------------------------------------------
333      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
334      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
335      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
336      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
337      !
338      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
339      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
340      !!
341      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
342         &                  nn_chldta, rn_abs, rn_si0, rn_si1
343      !!----------------------------------------------------------------------
344      !
345      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
346      !
347      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
348      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
349901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
350      !
351      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
352      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
353902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
354      IF(lwm) WRITE ( numond, namtra_qsr )
355      !
356      IF(lwp) THEN                ! control print
357         WRITE(numout,*)
358         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
359         WRITE(numout,*) '~~~~~~~~~~~~'
360         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
361         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
362         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
363         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
364         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
365         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
366         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
367         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
368         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
369         WRITE(numout,*)
370      ENDIF
371      !
372      ioptio = 0                    ! Parameter control
373      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
374      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
375      IF( ln_qsr_bio  )   ioptio = ioptio + 1
376      !
377      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
378         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
379      !
380      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
381      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
382      IF( ln_qsr_2bd                      )   nqsr = np_2BD
383      IF( ln_qsr_bio                      )   nqsr = np_BIO
384      !
385      !                             ! Initialisation
386      xsi0r = 1._wp / rn_si0
387      xsi1r = 1._wp / rn_si1
388      !
389      SELECT CASE( nqsr )
390      !                               
391      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
392         !                             
393         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
394         !
395         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
396         !                                   
397         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
398         !
399         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
400         !
401         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
402            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
403            ALLOCATE( sf_chl(1), STAT=ierror )
404            IF( ierror > 0 ) THEN
405               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
406            ENDIF
407            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
408            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
409            !                                        ! fill sf_chl with sn_chl and control print
410            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
411               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print )
412         ENDIF
413         IF( nqsr == np_RGB ) THEN                 ! constant Chl
414            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
415         ENDIF
416         !
417      CASE( np_2BD )                   !==  2 bands light penetration  ==!
418         !
419         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
420         !
421         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
422         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
423         !
424      CASE( np_BIO )                   !==  BIO light penetration  ==!
425         !
426         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
427         IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
428         !
429      END SELECT
430      !
431      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
432      !
433      ! 1st ocean level attenuation coefficient (used in sbcssm)
434      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
435         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
436      ELSE
437         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
438      ENDIF
439      !
440      IF( lwxios ) THEN
441         CALL iom_set_rstw_var_active('qsr_hc_b')
442         CALL iom_set_rstw_var_active('fraqsr_1lev')
443      ENDIF
444      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
445      !
446   END SUBROUTINE tra_qsr_init
447
448   !!======================================================================
449END MODULE traqsr
Note: See TracBrowser for help on using the repository browser.