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.
p2zopt.F90 in branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90 @ 5568

Last change on this file since 5568 was 5568, checked in by davestorkey, 9 years ago

Upgrade UKMO/dev_r5107_hadgem3_mct branch to trunk revision 5518
( = branching point for NEMO 3.6_stable).

File size: 10.7 KB
Line 
1MODULE p2zopt
2   !!======================================================================
3   !!                         ***  MODULE p2zopt  ***
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   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90
11   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style
12   !!----------------------------------------------------------------------
13#if defined key_pisces_reduced
14   !!----------------------------------------------------------------------
15   !!   'key_pisces_reduced'                                     LOBSTER bio-model
16   !!----------------------------------------------------------------------
17   !!   p2z_opt        :   Compute the light availability in the water column
18   !!----------------------------------------------------------------------
19   USE oce_trc         !
20   USE trc
21   USE sms_pisces
22   USE prtctl_trc      ! Print control for debbuging
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   p2z_opt   !
28   PUBLIC   p2z_opt_init   !
29
30   REAL(wp), PUBLIC ::  xkr0      !: water coefficient absorption in red     
31   REAL(wp), PUBLIC ::  xkg0      !: water coefficient absorption in green   
32   REAL(wp), PUBLIC ::  xkrp      !: pigment coefficient absorption in red   
33   REAL(wp), PUBLIC ::  xkgp      !: pigment coefficient absorption in green 
34   REAL(wp), PUBLIC ::  xlr       !: exposant for pigment absorption in red 
35   REAL(wp), PUBLIC ::  xlg       !: exposant for pigment absorption in green
36   REAL(wp), PUBLIC ::  rpig      !: chla/chla+phea ratio   
37   !                 
38   REAL(wp), PUBLIC ::  rcchl     ! Carbone/Chlorophyl ratio [mgC.mgChla-1]
39   REAL(wp), PUBLIC ::  redf      ! redfield ratio (C:N) for phyto
40   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
41
42   !!* Substitution
43#  include "top_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE p2z_opt( kt )
53      !!---------------------------------------------------------------------
54      !!                     ***  ROUTINE p2z_opt  ***
55      !!
56      !! ** Purpose :   computes the light propagation in the water column
57      !!              and the euphotic layer depth
58      !!
59      !! ** Method  :   local par is computed in w layers using light propagation
60      !!              mean par in t layers are computed by integration
61      !!
62!!gm please remplace the '???' by true comments
63      !! ** Action  :   etot   ???
64      !!                neln   ???
65      !!---------------------------------------------------------------------
66      !!
67      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
68      !!
69      INTEGER  ::   ji, jj, jk          ! dummy loop indices
70      CHARACTER (len=25) ::   charout   ! temporary character
71      REAL(wp) ::   zpig                ! log of the total pigment
72      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
73      REAL(wp) ::   zcoef               ! temporary scalar
74      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpar100, zpar0m
75      REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg
76      !!---------------------------------------------------------------------
77      !
78      IF( nn_timing == 1 )  CALL timing_start('p2z_opt')
79      !
80      ! Allocate temporary workspace
81      CALL wrk_alloc( jpi, jpj,      zpar100, zpar0m )
82      CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg    )
83
84      IF( kt == nittrc000 ) THEN
85         IF(lwp) WRITE(numout,*)
86         IF(lwp) WRITE(numout,*) ' p2z_opt : LOBSTER optic-model'
87         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
88      ENDIF
89
90      !                                          ! surface irradiance
91      !                                          ! ------------------
92      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
93      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
94      ENDIF
95      zpar100(:,:)   = zpar0m(:,:) * 0.01
96      zparr  (:,:,1) = zpar0m(:,:) * 0.5
97      zparg  (:,:,1) = zpar0m(:,:) * 0.5
98
99      !                                          ! Photosynthetically Available Radiation (PAR)
100      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
101      DO jk = 2, jpk                                  ! local par at w-levels
102         DO jj = 1, jpj
103            DO ji = 1, jpi
104               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
105               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
106               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
107               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
108               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
109            END DO
110        END DO
111      END DO
112      DO jk = 1, jpkm1                                ! mean par at t-levels
113         DO jj = 1, jpj
114            DO ji = 1, jpi
115               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  )
116               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
117               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
118               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
119               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
120               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
121            END DO
122         END DO
123      END DO
124
125      !                                          ! Euphotic layer
126      !                                          ! --------------
127      neln(:,:) = 1                                   ! euphotic layer level
128      DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom)
129         DO jj = 1, jpj
130           DO ji = 1, jpi
131              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
132              !                                       ! nb. this is to ensure compatibility with
133              !                                       ! nmld_trc definition in trd_mxl_trc_zint
134           END DO
135         END DO
136      END DO
137      !                                               ! Euphotic layer depth
138      DO jj = 1, jpj
139         DO ji = 1, jpi
140            heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))
141         END DO
142      END DO
143
144
145      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
146         WRITE(charout, FMT="('opt')")
147         CALL prt_ctl_trc_info( charout )
148         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
149      ENDIF
150      !
151      CALL wrk_dealloc( jpi, jpj,      zpar100, zpar0m )
152      CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg    )
153      !
154      IF( nn_timing == 1 )  CALL timing_stop('p2z_opt')
155      !
156   END SUBROUTINE p2z_opt
157
158   SUBROUTINE p2z_opt_init
159      !!----------------------------------------------------------------------
160      !!                  ***  ROUTINE p2z_opt_init  ***
161      !!
162      !! ** Purpose :  optical parameters
163      !!
164      !! ** Method  :   Read the namlobopt namelist and check the parameters
165      !!
166      !!----------------------------------------------------------------------
167      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
168      NAMELIST/namlobrat/ rcchl, redf, reddom
169      INTEGER :: ios                 ! Local integer output status for namelist read
170      !!----------------------------------------------------------------------
171
172      REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options
173      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
174901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist', lwp )
175
176      REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options
177      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
178902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist', lwp )
179      IF(lwm) WRITE ( numonp, namlobopt )
180
181      IF(lwp) THEN
182         WRITE(numout,*)
183         WRITE(numout,*) ' Namelist namlobopt'
184         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
185         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
186         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
187         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
188         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
189         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
190         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
191         WRITE(numout,*) ' '
192      ENDIF
193      !
194      REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios
195      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
196903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist', lwp )
197
198      REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios
199      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
200904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist', lwp )
201      IF(lwm) WRITE ( numonp, namlobrat )
202
203      IF(lwp) THEN
204          WRITE(numout,*) ' Namelist namlobrat'
205         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
206          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
207          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
208          WRITE(numout,*) ' '
209      ENDIF
210      !
211   END SUBROUTINE p2z_opt_init
212
213#else
214   !!======================================================================
215   !!  Dummy module :                                   No PISCES bio-model
216   !!======================================================================
217CONTAINS
218   SUBROUTINE p2z_opt( kt )                   ! Empty routine
219      INTEGER, INTENT( in ) ::   kt
220      WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt
221   END SUBROUTINE p2z_opt
222#endif 
223
224   !!======================================================================
225END MODULE  p2zopt
Note: See TracBrowser for help on using the repository browser.