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/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/PISCES/P2Z/p2zopt.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 9.1 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   !!----------------------------------------------------------------------
41   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
42   !! $Id$
43   !! Software governed by the CeCILL license (see ./LICENSE)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE p2z_opt( kt )
48      !!---------------------------------------------------------------------
49      !!                     ***  ROUTINE p2z_opt  ***
50      !!
51      !! ** Purpose :   computes the light propagation in the water column
52      !!              and the euphotic layer depth
53      !!
54      !! ** Method  :   local par is computed in w layers using light propagation
55      !!              mean par in t layers are computed by integration
56      !!
57!!gm please remplace the '???' by true comments
58      !! ** Action  :   etot   ???
59      !!                neln   ???
60      !!---------------------------------------------------------------------
61      !!
62      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
63      !!
64      INTEGER  ::   ji, jj, jk          ! dummy loop indices
65      CHARACTER (len=25) ::   charout   ! temporary character
66      REAL(wp) ::   zpig                ! log of the total pigment
67      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
68      REAL(wp) ::   zcoef               ! temporary scalar
69      REAL(wp), DIMENSION(jpi,jpj    ) :: zpar100, zpar0m
70      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg
71      !!---------------------------------------------------------------------
72      !
73      IF( ln_timing )   CALL timing_start('p2z_opt')
74      !
75
76      IF( kt == nittrc000 ) THEN
77         IF(lwp) WRITE(numout,*)
78         IF(lwp) WRITE(numout,*) ' p2z_opt : LOBSTER optic-model'
79         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
80      ENDIF
81
82      !                                          ! surface irradiance
83      !                                          ! ------------------
84      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
85      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
86      ENDIF
87      zpar100(:,:)   = zpar0m(:,:) * 0.01
88      zparr  (:,:,1) = zpar0m(:,:) * 0.5
89      zparg  (:,:,1) = zpar0m(:,:) * 0.5
90
91      !                                          ! Photosynthetically Available Radiation (PAR)
92      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
93      DO jk = 2, jpk                                  ! local par at w-levels
94         DO jj = 1, jpj
95            DO ji = 1, jpi
96               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
97               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
98               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
99               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) )
100               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) )
101            END DO
102        END DO
103      END DO
104      DO jk = 1, jpkm1                                ! mean par at t-levels
105         DO jj = 1, jpj
106            DO ji = 1, jpi
107               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  )
108               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
109               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
110               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) )
111               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) )
112               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
113            END DO
114         END DO
115      END DO
116
117      !                                          ! Euphotic layer
118      !                                          ! --------------
119      neln(:,:) = 1                                   ! euphotic layer level
120      DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom)
121         DO jj = 1, jpj
122           DO ji = 1, jpi
123              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
124           END DO
125         END DO
126      END DO
127      !                                               ! Euphotic layer depth
128      DO jj = 1, jpj
129         DO ji = 1, jpi
130            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj))
131         END DO
132      END DO
133
134
135      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
136         WRITE(charout, FMT="('opt')")
137         CALL prt_ctl_trc_info( charout )
138         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
139      ENDIF
140      !
141      IF( ln_timing )   CALL timing_stop('p2z_opt')
142      !
143   END SUBROUTINE p2z_opt
144
145
146   SUBROUTINE p2z_opt_init
147      !!----------------------------------------------------------------------
148      !!                  ***  ROUTINE p2z_opt_init  ***
149      !!
150      !! ** Purpose :  optical parameters
151      !!
152      !! ** Method  :   Read the namlobopt namelist and check the parameters
153      !!
154      !!----------------------------------------------------------------------
155      INTEGER ::   ios   ! Local integer
156      !!
157      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
158      NAMELIST/namlobrat/ rcchl, redf, reddom
159      !!----------------------------------------------------------------------
160
161      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
162901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' )
163
164      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
165902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' )
166      IF(lwm) WRITE ( numonp, namlobopt )
167
168      IF(lwp) THEN
169         WRITE(numout,*)
170         WRITE(numout,*) ' Namelist namlobopt'
171         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
172         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
173         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
174         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
175         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
176         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
177         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
178         WRITE(numout,*) ' '
179      ENDIF
180      !
181      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
182903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' )
183
184      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
185904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' )
186      IF(lwm) WRITE ( numonp, namlobrat )
187
188      IF(lwp) THEN
189          WRITE(numout,*) ' Namelist namlobrat'
190         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
191          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
192          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
193          WRITE(numout,*) ' '
194      ENDIF
195      !
196   END SUBROUTINE p2z_opt_init
197
198   !!======================================================================
199END MODULE p2zopt
Note: See TracBrowser for help on using the repository browser.