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 NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P2Z/p2zopt.F90 @ 13891

Last change on this file since 13891 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 8.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
14   !!----------------------------------------------------------------------
15   !!   p2z_opt        :   Compute the light availability in the water column
16   !!----------------------------------------------------------------------
17   USE oce_trc         !
18   USE trc
19   USE sms_pisces
20   USE prtctl_trc      ! Print control for debbuging
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p2z_opt   !
26   PUBLIC   p2z_opt_init   !
27
28   REAL(wp), PUBLIC ::  xkr0      !: water coefficient absorption in red     
29   REAL(wp), PUBLIC ::  xkg0      !: water coefficient absorption in green   
30   REAL(wp), PUBLIC ::  xkrp      !: pigment coefficient absorption in red   
31   REAL(wp), PUBLIC ::  xkgp      !: pigment coefficient absorption in green 
32   REAL(wp), PUBLIC ::  xlr       !: exposant for pigment absorption in red 
33   REAL(wp), PUBLIC ::  xlg       !: exposant for pigment absorption in green
34   REAL(wp), PUBLIC ::  rpig      !: chla/chla+phea ratio   
35   !                 
36   REAL(wp), PUBLIC ::  rcchl     ! Carbone/Chlorophyl ratio [mgC.mgChla-1]
37   REAL(wp), PUBLIC ::  redf      ! redfield ratio (C:N) for phyto
38   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
39
40   !! * Substitutions
41#  include "do_loop_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
44   !! $Id$
45   !! Software governed by the CeCILL license (see ./LICENSE)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE p2z_opt( kt, Kmm )
50      !!---------------------------------------------------------------------
51      !!                     ***  ROUTINE p2z_opt  ***
52      !!
53      !! ** Purpose :   computes the light propagation in the water column
54      !!              and the euphotic layer depth
55      !!
56      !! ** Method  :   local par is computed in w layers using light propagation
57      !!              mean par in t layers are computed by integration
58      !!
59!!gm please remplace the '???' by true comments
60      !! ** Action  :   etot   ???
61      !!                neln   ???
62      !!---------------------------------------------------------------------
63      !!
64      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
65      INTEGER, INTENT( in ) ::   Kmm  ! time level index
66      !!
67      INTEGER  ::   ji, jj, jk          ! dummy loop indices
68      CHARACTER (len=25) ::   charout   ! temporary character
69      REAL(wp) ::   zpig                ! log of the total pigment
70      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
71      REAL(wp) ::   zcoef               ! temporary scalar
72      REAL(wp), DIMENSION(jpi,jpj    ) :: zpar100, zpar0m
73      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg
74      !!---------------------------------------------------------------------
75      !
76      IF( ln_timing )   CALL timing_start('p2z_opt')
77      !
78
79      IF( kt == nittrc000 ) THEN
80         IF(lwp) WRITE(numout,*)
81         IF(lwp) WRITE(numout,*) ' p2z_opt : LOBSTER optic-model'
82         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
83      ENDIF
84
85      !                                          ! surface irradiance
86      !                                          ! ------------------
87      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
88      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
89      ENDIF
90      zpar100(:,:)   = zpar0m(:,:) * 0.01
91      zparr  (:,:,1) = zpar0m(:,:) * 0.5
92      zparg  (:,:,1) = zpar0m(:,:) * 0.5
93
94      !                                          ! Photosynthetically Available Radiation (PAR)
95      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
96      DO_3D_11_11( 2, jpk )
97         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  )
98         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
99         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
100         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) )
101         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) )
102      END_3D
103      DO_3D_11_11( 1, jpkm1 )
104         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  )
105         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
106         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
107         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) )
108         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) )
109         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
110      END_3D
111
112      !                                          ! Euphotic layer
113      !                                          ! --------------
114      neln(:,:) = 1                                   ! euphotic layer level
115      DO_3D_11_11( 1, jpkm1 )
116        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
117      END_3D
118      !                                               ! Euphotic layer depth
119      DO_2D_11_11
120         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm)
121      END_2D
122
123
124      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
125         WRITE(charout, FMT="('opt')")
126         CALL prt_ctl_trc_info( charout )
127         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
128      ENDIF
129      !
130      IF( ln_timing )   CALL timing_stop('p2z_opt')
131      !
132   END SUBROUTINE p2z_opt
133
134
135   SUBROUTINE p2z_opt_init
136      !!----------------------------------------------------------------------
137      !!                  ***  ROUTINE p2z_opt_init  ***
138      !!
139      !! ** Purpose :  optical parameters
140      !!
141      !! ** Method  :   Read the namlobopt namelist and check the parameters
142      !!
143      !!----------------------------------------------------------------------
144      INTEGER ::   ios   ! Local integer
145      !!
146      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
147      NAMELIST/namlobrat/ rcchl, redf, reddom
148      !!----------------------------------------------------------------------
149
150      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
151901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' )
152
153      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
154902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' )
155      IF(lwm) WRITE ( numonp, namlobopt )
156
157      IF(lwp) THEN
158         WRITE(numout,*)
159         WRITE(numout,*) ' Namelist namlobopt'
160         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
161         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
162         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
163         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
164         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
165         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
166         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
167         WRITE(numout,*) ' '
168      ENDIF
169      !
170      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
171903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' )
172
173      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
174904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' )
175      IF(lwm) WRITE ( numonp, namlobrat )
176
177      IF(lwp) THEN
178          WRITE(numout,*) ' Namelist namlobrat'
179         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
180          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
181          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
182          WRITE(numout,*) ' '
183      ENDIF
184      !
185   END SUBROUTINE p2z_opt_init
186
187   !!======================================================================
188END MODULE p2zopt
Note: See TracBrowser for help on using the repository browser.