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/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
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   !! * Substitutions
43#  include "domzgr_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.