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_tam.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traqsr_tam.F90 @ 1947

Last change on this file since 1947 was 1947, checked in by rblod, 14 years ago

adjustement for TAM branch
File size: 24.3 KB
Line 
1MODULE traqsr_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE  traqsr_tam  ***
5   !! Ocean physics: solar radiation penetration in the top ocean levels
6   !!                Tangent and Adjoint Module
7   !!======================================================================
8   !! History of the direct module: 
9   !!            6.0  !  90-10  (B. Blanke)  Original code
10   !!            7.0  !  91-11  (G. Madec)
11   !!                 !  96-01  (G. Madec)  s-coordinates
12   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
13   !!            9.0  !  05-11  (G. Madec) zco, zps, sco coordinate
14   !! History of the TAM:
15   !!                 !  08-05  (A. Vidard) Skeleton
16   !!                 !  08-09  (A. Vidard) TAM of the 05-11 version
17   !!----------------------------------------------------------------------
18
19   !!----------------------------------------------------------------------
20   !!   tra_qsr      : trend due to the solar radiation penetration
21   !!   tra_qsr_init : solar radiation penetration initialization
22   !!----------------------------------------------------------------------
23   USE par_kind      , ONLY: & ! Precision variables
24      & wp
25   USE par_oce       , ONLY: &
26      & jpi,                 &
27      & jpj,                 &
28      & jpk,                 &
29      & jpim1,               &
30      & jpjm1,               &
31      & jpkm1,               &
32      & jpiglo
33   USE oce_tam       , ONLY: & ! ocean dynamics and active tracers
34      & ta_tl,               &
35      & ta_ad
36   USE dom_oce       , ONLY: & ! ocean space and time domain
37      & tmask,               &
38      & ln_zco,              &
39      & ln_sco,              &
40      & ln_zps,              &
41      & e1t,                 &
42      & e2t,                 &
43#if ! defined key_zco
44      & e3t,                 &
45#endif
46      & e3t_0,               &
47      & gdepw_0,             &
48      & mig,                 &
49      & mjg,                 &
50      & nldi,                &
51      & nldj,                &
52      & nlei,                &
53      & nlej
54   USE in_out_manager, ONLY: & ! I/O manager
55      & lwp,                 &
56      & numout,              & 
57      & nit000,              & 
58      & nitend 
59   USE sbc_oce       , ONLY: & ! thermohaline fluxes
60      & qsr
61   USE sbc_oce_tam   , ONLY: & ! thermohaline fluxes
62      & qsr_tl,              &
63      & qsr_ad
64   USE phycst        , ONLY: & ! physical constants
65      & ro0cpr
66   USE prtctl        , ONLY: & ! Print control
67      & prt_ctl
68   USE gridrandom    , ONLY: & ! Random Gaussian noise on grids
69      & grid_random
70   USE dotprodfld    , ONLY: & ! Computes dot product for 3D and 2D fields
71      & dot_product
72   USE traqsr        , ONLY: & ! Solar radiation penetration
73      & ln_traqsr,           &
74      & tra_qsr_init,        &
75      & rabs,                &
76      & xsi1,                &
77      & xsi2,                &
78      & ln_qsr_sms,          &
79      & nksr, gdsr
80   USE trc_oce       , ONLY: & ! share SMS/Ocean variables
81      & etot3,               &
82      & lk_qsr_sms
83   USE trc_oce_tam   , ONLY: & ! share SMS/Ocean variables
84      & trc_oce_tam_init,    &
85      & etot3_tl,            &
86      & etot3_ad
87   USE tstool_tam    , ONLY: &
88      & prntst_adj,          &
89      & stdqsr,              &
90      & stdt
91   IMPLICIT NONE
92   PRIVATE
93
94   PUBLIC   tra_qsr_tan      ! routine called by step_tam.F90 (ln_traqsr=T)
95   PUBLIC   tra_qsr_adj      ! routine called by step_tam.F90 (ln_traqsr=T)
96   PUBLIC   tra_qsr_adj_tst  ! routine called by tst.F90
97
98   !! * Substitutions
99#  include "domzgr_substitute.h90"
100#  include "vectopt_loop_substitute.h90"
101
102CONTAINS
103
104   SUBROUTINE tra_qsr_tan( kt )
105      !!----------------------------------------------------------------------
106      !!                  ***  ROUTINE tra_qsr_tan  ***
107      !!
108      !! ** Purpose of the direct routine:   
109      !!      Compute the temperature trend due to the solar radiation
110      !!      penetration and add it to the general temperature trend.
111      !!
112      !! ** Method of the direct routine:
113      !!      The profile of the solar radiation within the ocean is
114      !!      defined through two penetration length scale (xsr1,xsr2) and a
115      !!      ratio (rabs) as :
116      !!         I(k) = Qsr*( rabs*EXP(z(k)/xsr1) + (1.-rabs)*EXP(z(k)/xsr2) )
117      !!         The temperature trend associated with the solar radiation
118      !!      penetration is given by :
119      !!            zta = 1/e3t dk[ I ] / (rau0*Cp)
120      !!         At the bottom, boudary condition for the radiation is no flux :
121      !!      all heat which has not been absorbed in the above levels is put
122      !!      in the last ocean level.
123      !!         In z-coordinate case, the computation is only done down to the
124      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients
125      !!      used for the computation are calculated one for once as they
126      !!      depends on k only.
127      !!
128      !! ** Action  : - update ta with the penetrative solar radiation trend
129      !!----------------------------------------------------------------------
130      INTEGER, INTENT(in) ::   kt     ! ocean time-step
131      !
132      !!
133      INTEGER  ::    ji, jj, jk       ! dummy loop indexes
134      REAL(wp) ::   zc0 , zc0tl , ztatl       ! temporary scalars
135      !!----------------------------------------------------------------------
136
137      IF( kt == nit000 ) THEN
138         IF(lwp) WRITE(numout,*)
139         IF(lwp) WRITE(numout,*) 'tra_qsr_tan : penetration of the surface solar radiation'
140         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
141         CALL tra_qsr_init
142         CALL tra_qsr_init_tan
143      ENDIF
144      ! ---------------------------------------------- !
145      !  Biological fluxes  : all vertical coordinate  !
146      ! ---------------------------------------------- !
147      IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN     
148         !                                                   ! ===============
149         DO jk = 1, jpkm1                                    ! Horizontal slab
150            !                                                ! ===============
151            DO jj = 2, jpjm1
152               DO ji = fs_2, fs_jpim1   ! vector opt.
153                  zc0 = ro0cpr  / fse3t(ji,jj,jk)         ! compute the qsr trend
154                  ztatl = zc0 * ( etot3_tl(ji,jj,jk  ) * tmask(ji,jj,jk)     &
155                     &        - etot3_tl(ji,jj,jk+1) * tmask(ji,jj,jk+1) )
156                  ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) + ztatl       ! add qsr trend to the temperature trend
157               END DO
158            END DO
159            !                                                ! ===============
160         END DO                                              !   End of slab
161         !                                                   ! ===============
162
163      ! ---------------------------------------------- !
164      !  Ocean alone :
165      ! ---------------------------------------------- !
166      ELSE
167         !                                                ! =================== !
168         IF( ln_sco ) THEN                                !    s-coordinate     !
169            !                                             ! =================== !
170            DO jk = 1, jpkm1
171               ta_tl(:,:,jk) = ta_tl(:,:,jk) + etot3_tl(:,:,jk) * qsr(:,:) + etot3(:,:,jk) * qsr_tl(:,:)
172            END DO
173         ENDIF
174         !                                                ! =================== !
175         IF( ln_zps ) THEN                                !    partial steps    !
176            !                                             ! =================== !
177            DO jk = 1, nksr
178               DO jj = 2, jpjm1
179                  DO ji = fs_2, fs_jpim1   ! vector opt.
180                     ! qsr trend from gdsr
181                     zc0tl = qsr_tl(ji,jj) / fse3t(ji,jj,jk)
182                     ztatl = zc0tl * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) )
183                     ! add qsr trend to the temperature trend
184                     ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) + ztatl
185                  END DO
186               END DO
187            END DO
188         ENDIF
189         !                                                ! =================== !
190         IF( ln_zco ) THEN                                !     z-coordinate    !
191            !                                             ! =================== !
192            DO jk = 1, nksr
193               zc0 = 1. / e3t_0(jk)
194               DO jj = 2, jpjm1
195                  DO ji = fs_2, fs_jpim1   ! vector opt.
196                     ! qsr trend
197                     ztatl = qsr_tl(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) )
198                     ! add qsr trend to the temperature trend
199                     ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) + ztatl     
200                  END DO
201               END DO
202            END DO
203         ENDIF
204         !
205      ENDIF
206
207      !
208   END SUBROUTINE tra_qsr_tan
209   SUBROUTINE tra_qsr_adj( kt )
210      !!----------------------------------------------------------------------
211      !!                  ***  ROUTINE tra_qsr_adj  ***
212      !!
213      !! ** Purpose of the direct routine:   
214      !!      Compute the temperature trend due to the solar radiation
215      !!      penetration and add it to the general temperature trend.
216      !!
217      !! ** Method of the direct routine:
218      !!      The profile of the solar radiation within the ocean is
219      !!      defined through two penetration length scale (xsr1,xsr2) and a
220      !!      ratio (rabs) as :
221      !!         I(k) = Qsr*( rabs*EXP(z(k)/xsr1) + (1.-rabs)*EXP(z(k)/xsr2) )
222      !!         The temperature trend associated with the solar radiation
223      !!      penetration is given by :
224      !!            zta = 1/e3t dk[ I ] / (rau0*Cp)
225      !!         At the bottom, boudary condition for the radiation is no flux :
226      !!      all heat which has not been absorbed in the above levels is put
227      !!      in the last ocean level.
228      !!         In z-coordinate case, the computation is only done down to the
229      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients
230      !!      used for the computation are calculated one for once as they
231      !!      depends on k only.
232      !!
233      !! ** Action  : - update ta with the penetrative solar radiation trend
234      !!----------------------------------------------------------------------
235      !!
236      INTEGER, INTENT(in) ::   kt     ! ocean time-step
237      !
238      !!
239      INTEGER  ::    ji, jj, jk       ! dummy loop indexes
240      REAL(wp) ::   zc0 , zc0ad       ! temporary scalars
241      !!----------------------------------------------------------------------
242      IF( kt == nitend ) THEN
243         IF(lwp) WRITE(numout,*)
244         IF(lwp) WRITE(numout,*) 'tra_qsr_adj : penetration of the surface solar radiation'
245         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
246         CALL tra_qsr_init
247      ENDIF
248
249      ! ---------------------------------------------- !
250      !  Biological fluxes  : all vertical coordinate  !
251      ! ---------------------------------------------- !
252      IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN 
253         !                                                   ! ===============
254         DO jk = jpkm1, 1, -1                                ! Horizontal slab
255            !                                                ! ===============
256            DO jj = 2, jpjm1
257               DO ji = fs_2, fs_jpim1   ! vector opt.
258                  zc0 = ro0cpr  / fse3t(ji,jj,jk)         ! compute the qsr trend
259                  etot3_ad(ji,jj,jk  ) = etot3_ad(ji,jj,jk  ) + ta_ad(ji,jj,jk) * zc0 * tmask(ji,jj,jk)
260                  etot3_ad(ji,jj,jk+1) = etot3_ad(ji,jj,jk+1) - ta_ad(ji,jj,jk) * zc0 * tmask(ji,jj,jk+1)
261               END DO
262            END DO
263            !                                                ! ===============
264         END DO                                              !   End of slab
265         !                                                   ! ===============
266
267      ! ---------------------------------------------- !
268      !  Ocean alone :
269      ! ---------------------------------------------- !
270      ELSE
271         !                                                ! =================== !
272         IF( ln_zco ) THEN                                !     z-coordinate    !
273            !                                             ! =================== !
274            DO jk = nksr, 1, -1
275               zc0 = 1. / e3t_0(jk)
276               DO jj = 2, jpjm1
277                  DO ji = fs_2, fs_jpim1   ! vector opt.
278                     ! qsr trend
279                     qsr_ad(ji,jj) = qsr_ad(ji,jj) + ta_ad(ji,jj,jk) * zc0   &
280                                   &   * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) )
281                  END DO
282               END DO
283            END DO
284         ENDIF
285         !                                                ! =================== !
286         IF( ln_zps ) THEN                                !    partial steps    !
287            !                                             ! =================== !
288            DO jk = 1, nksr
289               DO jj = 2, jpjm1
290                  DO ji = fs_2, fs_jpim1   ! vector opt.
291                     ! qsr trend from gdsr
292                     zc0ad = ta_ad(ji,jj,jk) * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) )
293                     qsr_ad(ji,jj) = qsr_ad(ji,jj) + zc0ad / fse3t(ji,jj,jk)
294                  END DO
295               END DO
296            END DO
297         ENDIF
298         !                                                ! =================== !
299         IF( ln_sco ) THEN                                !    s-coordinate     !
300            !                                             ! =================== !
301            DO jk = jpkm1, 1, -1
302               etot3_ad(:,:,jk) = etot3_ad(:,:,jk) + ta_ad(:,:,jk) * qsr(:,:)
303               qsr_ad(:,:)      = qsr_ad(:,:)      + ta_ad(:,:,jk) * etot3(:,:,jk)
304            END DO
305         ENDIF
306         !
307      ENDIF
308      IF( kt == nit000 ) THEN
309         CALL tra_qsr_init_adj
310      ENDIF
311
312   END SUBROUTINE tra_qsr_adj
313   SUBROUTINE tra_qsr_adj_tst ( kumadt ) 
314      !!-----------------------------------------------------------------------
315      !!
316      !!          ***  ROUTINE tra_sbc_adj_tst : TEST OF tra_sbc_adj  ***
317      !!
318      !! ** Purpose : Test the adjoint routine.
319      !!
320      !! ** Method  : Verify the scalar product
321      !!           
322      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
323      !!
324      !!              where  L   = tangent routine
325      !!                     L^T = adjoint routine
326      !!                     W   = diagonal matrix of scale factors
327      !!                     dx  = input perturbation (random field)
328      !!                     dy  = L dx
329      !!
330      !! History :
331      !!        ! 08-08 (A. Vidard)
332      !!-----------------------------------------------------------------------
333      !! * Modules used
334
335      !! * Arguments
336      INTEGER, INTENT(IN) :: &
337         & kumadt             ! Output unit
338 
339      INTEGER ::  &
340         & jstp,  &
341         & ji,    &        ! dummy loop indices
342         & jj,    &       
343         & jk     
344      INTEGER, DIMENSION(jpi,jpj) :: &
345         & iseed_2d        ! 2D seed for the random number generator
346
347      !! * Local declarations
348      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
349         & zta_tlin,     &! Tangent input : after temperature
350         & zta_tlout,    &! Tangent output: after temperature
351         & zta_adout,    &! Adjoint output: after temperature
352         & zta_adin,     &! Adjoint input : after temperature
353         & zta            ! temporary after temperature
354      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
355         & zqsr_tlin,    &! Tangent input : solar radiation (w/m2)
356         & zqsr_adout,   &! Adjoint output: solar radiation (w/m2)
357         & zqsr           ! temporary solar radiation (w/m2)
358      REAL(KIND=wp) ::       &
359         & zsp1,             & ! scalar product involving the tangent routine
360         & zsp2,             & ! scalar product involving the adjoint routine
361         & zsp2_1,           & ! scalar product involving the adjoint routine
362         & zsp2_2              ! scalar product involving the adjoint routine
363      CHARACTER(LEN=14) :: &
364         & cl_name
365
366      ALLOCATE( & 
367         & zta_tlin(jpi,jpj,jpk),     &
368         & zta_tlout(jpi,jpj,jpk),    &
369         & zta_adout(jpi,jpj,jpk),    &
370         & zta_adin(jpi,jpj,jpk),     &
371         & zta(jpi,jpj,jpk),          &
372         & zqsr_tlin(jpi,jpj),        &
373         & zqsr_adout(jpi,jpj),       &
374         & zqsr(jpi,jpj)              &
375         & )
376      ! Initialize the reference state
377      qsr(:,:) = 1.0_wp ! ???
378      ! Initialize random field standard deviations
379      !=============================================================
380      ! 1) dx = ( T ) and dy = ( T )
381      !=============================================================
382
383      CALL trc_oce_tam_init( 0 )
384
385      !--------------------------------------------------------------------
386      ! Reset the tangent and adjoint variables
387      !--------------------------------------------------------------------
388      zta_tlin(:,:,:)  = 0.0_wp     
389      zta_tlout(:,:,:) = 0.0_wp   
390      zta_adout(:,:,:) = 0.0_wp   
391      zta_adin(:,:,:)  = 0.0_wp     
392      zqsr_adout(:,:)  = 0.0_wp       
393      zqsr_tlin(:,:)   = 0.0_wp 
394     
395      DO jj = 1, jpj
396         DO ji = 1, jpi
397            iseed_2d(ji,jj) = - ( 358606 + &
398               &                  mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
399         END DO
400      END DO
401      CALL grid_random( iseed_2d, zqsr, 'T', 0.0_wp, stdqsr )
402      DO jj = 1, jpj
403         DO ji = 1, jpi
404            iseed_2d(ji,jj) = - ( 232567 + &
405               &                  mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
406         END DO
407      END DO
408      CALL grid_random( iseed_2d, zta, 'T', 0.0_wp, stdt )
409      DO jk = 1, jpk
410         DO jj = nldj, nlej
411            DO ji = nldi, nlei
412               zta_tlin(ji,jj,jk) = zta(ji,jj,jk)
413            END DO
414         END DO
415      END DO
416      DO jj = nldj, nlej
417         DO ji = nldi, nlei
418            zqsr_tlin(ji,jj)  = zqsr(ji,jj)
419         END DO
420      END DO
421      ! Test for time steps nit000 and nit000 + 1 (the matrix changes)
422      DO jstp = nit000, nit000 + 1
423         !--------------------------------------------------------------------
424         ! Call the tangent routine: dy = L dx
425         !--------------------------------------------------------------------
426         
427         ta_tl(:,:,:) = zta_tlin(:,:,:)
428         qsr_tl(:,:)  = zqsr_tlin(:,:)
429     
430         CALL tra_qsr_tan( jstp )
431         
432         zta_tlout(:,:,:) = ta_tl(:,:,:)
433         
434         !--------------------------------------------------------------------
435         ! Initialize the adjoint variables: dy^* = W dy
436         !--------------------------------------------------------------------
437     
438         DO jk = 1, jpk
439            DO jj = nldj, nlej
440               DO ji = nldi, nlei
441                  zta_adin(ji,jj,jk) = zta_tlout(ji,jj,jk) &
442                     &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
443                     &               * tmask(ji,jj,jk)
444               END DO
445            END DO
446         END DO
447
448         !--------------------------------------------------------------------
449         ! Compute the scalar product: ( L dx )^T W dy
450         !--------------------------------------------------------------------
451
452         zsp1 = DOT_PRODUCT( zta_tlout, zta_adin )
453
454         !--------------------------------------------------------------------
455         ! Call the adjoint routine: dx^* = L^T dy^*
456         !--------------------------------------------------------------------
457
458         qsr_ad(:,:)      = 0.0_wp       
459         ta_ad(:,:,:) = zta_adin(:,:,:)
460         
461         CALL tra_qsr_adj( jstp )
462
463         zta_adout(:,:,:) = ta_ad(:,:,:)
464         zqsr_adout(:,:)  = qsr_ad(:,:)
465     
466         !--------------------------------------------------------------------
467         ! Compute the scalar product: dx^T L^T W dy
468         !--------------------------------------------------------------------
469
470         zsp2_1 = DOT_PRODUCT( zta_tlin  , zta_adout   )
471         zsp2_2 = DOT_PRODUCT( zqsr_tlin , zqsr_adout  )
472     
473         zsp2 = zsp2_1 + zsp2_2
474     
475         ! Compare the scalar products
476     
477         ! 14 char:   '12345678901234'
478         IF (jstp == nit000) THEN
479            cl_name = 'tra_qsr_adj  1'
480         ELSE
481            cl_name = 'tra_qsr_adj  2'
482         END IF
483         CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
484      END DO
485     
486      DEALLOCATE( & 
487         & zta_tlin,     &
488         & zta_tlout,    &
489         & zta_adout,    &
490         & zta_adin,     &
491         & zta,          &
492         & zqsr_adout,   &
493         & zqsr_tlin,    &
494         & zqsr          &
495         & )
496
497      !
498   END SUBROUTINE tra_qsr_adj_tst
499   SUBROUTINE tra_qsr_init_tan
500      !!----------------------------------------------------------------------
501      !!                  ***  ROUTINE tra_qsr_init_tan  ***
502      !!
503      !! ** Purpose :   Initialization for the penetrative solar radiation
504      !!
505      !! ** Method  :   The profile of solar radiation within the ocean is set
506      !!      from two length scale of penetration (xsr1,xsr2) and a ratio
507      !!      (rabs). These parameters are read in the namqsr namelist. The
508      !!      default values correspond to clear water (type I in Jerlov'
509      !!      (1968) classification.
510      !!         called by tra_qsr at the first timestep (nit000)
511      !!
512      !! ** Action  : - initialize xsr1, xsr2 and rabs
513      !!
514      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
515      !!----------------------------------------------------------------------
516      INTEGER  ::   ji, jj, jk   ! dummy loop index
517      INTEGER  ::   indic        ! temporary integer
518      REAL(wp) ::   zcst, zdp1    ! temporary scalars
519
520      !                           ! Initialization of gdsr
521      IF( ln_zco .OR. ln_zps ) THEN
522         !
523         ! Initialisation of Biological fluxes for light here because
524         ! the optical biological model is call after the dynamical one
525         IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN
526            DO jk = 1, jpkm1
527               zcst = gdsr(jk) / ro0cpr
528               etot3_tl(:,:,jk) = qsr_tl(:,:) * zcst * tmask(:,:,jk)
529            END DO
530         ENDIF
531         !
532      ENDIF
533
534      ! Initialisation of etot3 (s-coordinate)
535      ! -----------------------
536      IF( ln_sco ) THEN
537         etot3_tl(:,:,:) = 0.e0
538      ENDIF
539      !
540   END SUBROUTINE tra_qsr_init_tan
541   SUBROUTINE tra_qsr_init_adj
542      !!----------------------------------------------------------------------
543      !!                  ***  ROUTINE tra_qsr_init_adj  ***
544      !!
545      !! ** Purpose :   Initialization for the penetrative solar radiation
546      !!
547      !! ** Method  :   The profile of solar radiation within the ocean is set
548      !!      from two length scale of penetration (xsr1,xsr2) and a ratio
549      !!      (rabs). These parameters are read in the namqsr namelist. The
550      !!      default values correspond to clear water (type I in Jerlov'
551      !!      (1968) classification.
552      !!         called by tra_qsr at the first timestep (nit000)
553      !!
554      !! ** Action  : - initialize xsr1, xsr2 and rabs
555      !!
556      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
557      !!----------------------------------------------------------------------
558      INTEGER  ::   ji, jj, jk   ! dummy loop index
559      INTEGER  ::   indic        ! temporary integer
560      REAL(wp) ::   zcst, zdp1    ! temporary scalars
561
562      ! Initialisation of etot3 (s-coordinate)
563      ! -----------------------
564      IF( ln_sco ) THEN
565         etot3_ad(:,:,:) = 0.e0
566      ENDIF
567      !                           ! Initialization of gdsr
568      IF( ln_zco .OR. ln_zps ) THEN
569         !
570         ! z-coordinate with or without partial step : same w-level everywhere inside the ocean
571         ! Initialisation of Biological fluxes for light here because
572         ! the optical biological model is call after the dynamical one
573         IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN
574            DO jk = 1, jpkm1
575               zcst = gdsr(jk) / ro0cpr
576               qsr_ad(:,:) = qsr_ad(:,:) + etot3_ad(:,:,jk)  * zcst * tmask(:,:,jk)
577               etot3_ad(:,:,jk) = 0.0_wp
578            END DO
579         ENDIF
580         !
581      ENDIF
582
583      !
584  END SUBROUTINE tra_qsr_init_adj
585
586   !!======================================================================
587#endif
588END MODULE traqsr_tam
Note: See TracBrowser for help on using the repository browser.