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.
trcopt.F90 in trunk/NEMO/TOP_SRC/LOBSTER – NEMO

source: trunk/NEMO/TOP_SRC/LOBSTER/trcopt.F90 @ 1284

Last change on this file since 1284 was 1176, checked in by cetlod, 16 years ago

update LOBSTER modules to take into account new trends organization, see ticket:248
  • Property svn:keywords set to Id
File size: 6.2 KB
Line 
1MODULE trcopt
2   !!======================================================================
3   !!                         ***  MODULE trcopt  ***
4   !! TOP :   LOBSTER Compute the light availability in the water column
5   !!======================================================================
6   !! History :    -   !  1995-05  (M. Levy) Original code
7   !!              -   !  1999-09  (J.-M. Andre, M. Levy)
8   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial
9   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x))
10   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
11   !!----------------------------------------------------------------------
12#if defined key_lobster
13   !!----------------------------------------------------------------------
14   !!   'key_lobster'                                     LOBSTER bio-model
15   !!----------------------------------------------------------------------
16   !!   trc_opt        :   Compute the light availability in the water column
17   !!----------------------------------------------------------------------
18   USE oce_trc         !
19   USE trc
20   USE sms_lobster
21   USE prtctl_trc      ! Print control for debbuging
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_opt   ! called in trcprg.F90
27
28   !!* Substitution
29#  include "domzgr_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
32   !! $Id$
33   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35
36CONTAINS
37
38   SUBROUTINE trc_opt( kt )
39      !!---------------------------------------------------------------------
40      !!                     ***  ROUTINE trc_opt  ***
41      !!
42      !! ** Purpose :   computes the light propagation in the water column
43      !!              and the euphotic layer depth
44      !!
45      !! ** Method  :   local par is computed in w layers using light propagation
46      !!              mean par in t layers are computed by integration
47      !!---------------------------------------------------------------------
48      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
49      INTEGER  ::   ji, jj, jk
50      REAL(wp) ::   zpig                                    ! total pigment
51      REAL(wp) ::   zkr                                     ! total absorption coefficient in red
52      REAL(wp) ::   zkg                                     ! total absorption coefficient in green
53      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar100         ! irradiance at euphotic layer depth
54      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface
55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par
56
57      CHARACTER (len=25) :: charout
58      !!---------------------------------------------------------------------
59
60      IF( kt == nit000 ) THEN
61         IF(lwp) WRITE(numout,*)
62         IF(lwp) WRITE(numout,*) ' trc_opt: LOBSTER optic-model'
63         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
64      ENDIF
65
66      ! determination of surface irradiance
67      ! -----------------------------------
68      zpar0m (:,:)   = qsr   (:,:) * 0.43
69      zpar100(:,:)   = zpar0m(:,:) * 0.01
70      xpar   (:,:,1) = zpar0m(:,:)
71      zparr  (:,:,1) = 0.5 * zpar0m(:,:)
72      zparg  (:,:,1) = 0.5 * zpar0m(:,:)
73
74
75      ! determination of xpar
76      ! ---------------------
77
78      DO jk = 2, jpk                     ! determination of local par in w levels
79         DO jj = 1, jpj
80            DO ji = 1, jpi
81               zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * 12 * redf / rcchl / rpig
82               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
83               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
84               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
85               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
86            END DO
87        END DO
88      END DO
89
90      DO jk = 1, jpkm1                   ! mean par in t levels
91         DO jj = 1, jpj
92            DO ji = 1, jpi
93               zpig = MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * 12 * redf / rcchl / rpig
94               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
95               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
96               zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) )
97               zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) )
98               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
99            END DO
100         END DO
101      END DO
102
103      ! 3. Determination of euphotic layer depth
104      ! ----------------------------------------
105
106      ! Euphotic layer bottom level
107      neln(:,:) = 1                                           ! initialisation of EL level
108      DO jk = 1, jpk
109         DO jj = 1, jpj
110           DO ji = 1, jpi
111              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom
112              !                                                  ! nb. this is to ensure compatibility with
113              !                                                  ! nmld_trc definition in trd_mld_trc_zint
114           END DO
115         END DO
116      ENDDO
117
118      ! Euphotic layer depth
119      DO jj = 1, jpj
120         DO ji = 1, jpi
121            xze(ji,jj) = fsdepw( ji, jj, neln(ji,jj) )            ! exact EL depth
122         END DO
123      ENDDO 
124
125
126      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
127         WRITE(charout, FMT="('opt')")
128         CALL prt_ctl_trc_info(charout)
129         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
130      ENDIF
131
132   END SUBROUTINE trc_opt
133
134#else
135   !!======================================================================
136   !!  Dummy module :                                   No PISCES bio-model
137   !!======================================================================
138CONTAINS
139   SUBROUTINE trc_opt( kt )                   ! Empty routine
140      INTEGER, INTENT( in ) ::   kt
141      WRITE(*,*) 'trc_opt: You should not have seen this print! error?', kt
142   END SUBROUTINE trc_opt
143#endif 
144
145   !!======================================================================
146END MODULE  trcopt
Note: See TracBrowser for help on using the repository browser.