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/NEMOGCM/NEMO/TOP_SRC/LOBSTER – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90 @ 3318

Last change on this file since 3318 was 3294, checked in by rblod, 12 years ago

Merge of 3.4beta into the trunk
  • Property svn:keywords set to Id
File size: 6.9 KB
RevLine 
[934]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))
[1445]10   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90
11   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style
[934]12   !!----------------------------------------------------------------------
13#if defined key_lobster
14   !!----------------------------------------------------------------------
15   !!   'key_lobster'                                     LOBSTER bio-model
16   !!----------------------------------------------------------------------
17   !!   trc_opt        :   Compute the light availability in the water column
18   !!----------------------------------------------------------------------
19   USE oce_trc         !
[1119]20   USE trc
[1071]21   USE sms_lobster
[934]22   USE prtctl_trc      ! Print control for debbuging
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   trc_opt   ! called in trcprg.F90
28
29   !!* Substitution
[1800]30#  include "top_substitute.h90"
[934]31   !!----------------------------------------------------------------------
[2528]32   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1146]33   !! $Id$
[2528]34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[934]35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE trc_opt( kt )
40      !!---------------------------------------------------------------------
41      !!                     ***  ROUTINE trc_opt  ***
42      !!
43      !! ** Purpose :   computes the light propagation in the water column
44      !!              and the euphotic layer depth
45      !!
46      !! ** Method  :   local par is computed in w layers using light propagation
47      !!              mean par in t layers are computed by integration
[1445]48      !!
49!!gm please remplace the '???' by true comments
50      !! ** Action  :   xpar   ???
51      !!                neln   ???
52      !!                xze    ???
[934]53      !!---------------------------------------------------------------------
[2715]54      !!
[934]55      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
[1445]56      !!
57      INTEGER  ::   ji, jj, jk          ! dummy loop indices
58      CHARACTER (len=25) ::   charout   ! temporary character
59      REAL(wp) ::   zpig                ! log of the total pigment
60      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
61      REAL(wp) ::   zcoef               ! temporary scalar
[3294]62      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpar100, zpar0m 
63      REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg
[934]64      !!---------------------------------------------------------------------
[3294]65      !
66      IF( nn_timing == 1 )  CALL timing_start('trc_opt')
67      !
68      ! Allocate temporary workspace
69      CALL wrk_alloc( jpi, jpj,      zpar100, zpar0m )
70      CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg    )
[934]71
[3294]72      IF( kt == nittrc000 ) THEN
[934]73         IF(lwp) WRITE(numout,*)
[1445]74         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model'
75         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
[934]76      ENDIF
77
[1445]78      !                                          ! surface irradiance
79      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------
[934]80      zpar100(:,:)   = zpar0m(:,:) * 0.01
81      xpar   (:,:,1) = zpar0m(:,:)
[1445]82      zparr  (:,:,1) = zpar0m(:,:) * 0.5
83      zparg  (:,:,1) = zpar0m(:,:) * 0.5
[934]84
[1445]85      !                                          ! Photosynthetically Available Radiation (PAR)
86      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
87      DO jk = 2, jpk                                  ! local par at w-levels
[934]88         DO jj = 1, jpj
89            DO ji = 1, jpi
[2528]90               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jp_lob_phy) ) * zcoef  )
[1445]91               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
92               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
[934]93               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
94               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
95            END DO
96        END DO
97      END DO
[1445]98      DO jk = 1, jpkm1                                ! mean par at t-levels
[934]99         DO jj = 1, jpj
100            DO ji = 1, jpi
[2528]101               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jp_lob_phy) ) * zcoef  )
[1445]102               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
103               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
104               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
105               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
[934]106               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
107            END DO
108         END DO
109      END DO
110
[1445]111      !                                          ! Euphotic layer
112      !                                          ! --------------
113      neln(:,:) = 1                                   ! euphotic layer level
114      DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom)
[934]115         DO jj = 1, jpj
[1176]116           DO ji = 1, jpi
[1445]117              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
118              !                                       ! nb. this is to ensure compatibility with
119              !                                       ! nmld_trc definition in trd_mld_trc_zint
[1176]120           END DO
[934]121         END DO
[1445]122      END DO
123      !                                               ! Euphotic layer depth
[1176]124      DO jj = 1, jpj
125         DO ji = 1, jpi
[1445]126            xze(ji,jj) = fsdepw(ji,jj,neln(ji,jj))
[934]127         END DO
[1445]128      END DO
[934]129
[1176]130
[1445]131      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
[934]132         WRITE(charout, FMT="('opt')")
[1445]133         CALL prt_ctl_trc_info( charout )
[1119]134         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
[934]135      ENDIF
[1445]136      !
[3294]137      CALL wrk_dealloc( jpi, jpj,      zpar100, zpar0m )
138      CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg    )
[2715]139      !
[3294]140      IF( nn_timing == 1 )  CALL timing_stop('trc_opt')
141      !
[934]142   END SUBROUTINE trc_opt
143
144#else
145   !!======================================================================
146   !!  Dummy module :                                   No PISCES bio-model
147   !!======================================================================
148CONTAINS
149   SUBROUTINE trc_opt( kt )                   ! Empty routine
150      INTEGER, INTENT( in ) ::   kt
151      WRITE(*,*) 'trc_opt: You should not have seen this print! error?', kt
152   END SUBROUTINE trc_opt
153#endif 
154
155   !!======================================================================
156END MODULE  trcopt
Note: See TracBrowser for help on using the repository browser.