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

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
File size: 10.6 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: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $
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      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------
92      zpar100(:,:)   = zpar0m(:,:) * 0.01
93      zparr  (:,:,1) = zpar0m(:,:) * 0.5
94      zparg  (:,:,1) = zpar0m(:,:) * 0.5
95
96      !                                          ! Photosynthetically Available Radiation (PAR)
97      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
98      DO jk = 2, jpk                                  ! local par at w-levels
99         DO jj = 1, jpj
100            DO ji = 1, jpi
101               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
102               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
103               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
104               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
105               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
106            END DO
107        END DO
108      END DO
109      DO jk = 1, jpkm1                                ! mean par at t-levels
110         DO jj = 1, jpj
111            DO ji = 1, jpi
112               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  )
113               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
114               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
115               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
116               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
117               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
118            END DO
119         END DO
120      END DO
121
122      !                                          ! Euphotic layer
123      !                                          ! --------------
124      neln(:,:) = 1                                   ! euphotic layer level
125      DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom)
126         DO jj = 1, jpj
127           DO ji = 1, jpi
128              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
129              !                                       ! nb. this is to ensure compatibility with
130              !                                       ! nmld_trc definition in trd_mld_trc_zint
131           END DO
132         END DO
133      END DO
134      !                                               ! Euphotic layer depth
135      DO jj = 1, jpj
136         DO ji = 1, jpi
137            heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))
138         END DO
139      END DO
140
141
142      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
143         WRITE(charout, FMT="('opt')")
144         CALL prt_ctl_trc_info( charout )
145         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
146      ENDIF
147      !
148      CALL wrk_dealloc( jpi, jpj,      zpar100, zpar0m )
149      CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg    )
150      !
151      IF( nn_timing == 1 )  CALL timing_stop('p2z_opt')
152      !
153   END SUBROUTINE p2z_opt
154
155   SUBROUTINE p2z_opt_init
156      !!----------------------------------------------------------------------
157      !!                  ***  ROUTINE p2z_opt_init  ***
158      !!
159      !! ** Purpose :  optical parameters
160      !!
161      !! ** Method  :   Read the namlobopt namelist and check the parameters
162      !!
163      !!----------------------------------------------------------------------
164      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
165      NAMELIST/namlobrat/ rcchl, redf, reddom
166      INTEGER :: ios                 ! Local integer output status for namelist read
167      !!----------------------------------------------------------------------
168
169      REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options
170      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
171901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist', lwp )
172
173      REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options
174      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
175902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist', lwp )
176      IF(lwm) WRITE ( numonp, namlobopt )
177
178      IF(lwp) THEN
179         WRITE(numout,*)
180         WRITE(numout,*) ' Namelist namlobopt'
181         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
182         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
183         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
184         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
185         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
186         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
187         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
188         WRITE(numout,*) ' '
189      ENDIF
190      !
191      REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios
192      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
193903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist', lwp )
194
195      REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios
196      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
197904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist', lwp )
198      IF(lwm) WRITE ( numonp, namlobrat )
199
200      IF(lwp) THEN
201          WRITE(numout,*) ' Namelist namlobrat'
202         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
203          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
204          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
205          WRITE(numout,*) ' '
206      ENDIF
207      !
208   END SUBROUTINE p2z_opt_init
209
210#else
211   !!======================================================================
212   !!  Dummy module :                                   No PISCES bio-model
213   !!======================================================================
214CONTAINS
215   SUBROUTINE p2z_opt( kt )                   ! Empty routine
216      INTEGER, INTENT( in ) ::   kt
217      WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt
218   END SUBROUTINE p2z_opt
219#endif 
220
221   !!======================================================================
222END MODULE  p2zopt
Note: See TracBrowser for help on using the repository browser.