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.
trc_oce.F90 in NEMO/branches/2020/r12377_ticket2386/src/OCE – NEMO

source: NEMO/branches/2020/r12377_ticket2386/src/OCE/trc_oce.F90 @ 12808

Last change on this file since 12808 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: 15.8 KB
Line 
1MODULE trc_oce
2   !!======================================================================
3   !!                      ***  MODULE  trc_oce  ***
4   !! Ocean passive tracer  :  share SMS/Ocean variables
5   !!======================================================================
6   !! History :  1.0  !  2004-03  (C. Ethe)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   trc_oce_rgb   : tabulated attenuation coefficients for RGB light penetration         
11   !!----------------------------------------------------------------------
12   USE par_oce        ! ocean parameters
13   USE dom_oce        ! ocean space and time domain
14   !
15   USE in_out_manager ! I/O manager
16   USE lib_mpp        ! MPP library
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   trc_oce_rgb        ! routine called by traqsr.F90
22   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90
23   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least
24   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
25
26   LOGICAL , PUBLIC ::   l_co2cpl  = .false.   !: atmospheric pco2 recieved from oasis
27   LOGICAL , PUBLIC ::   l_offline = .false.   !: offline passive tracers flag
28   REAL(wp), PUBLIC ::   r_si2                 !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
29   !
30   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3     !: light absortion coefficient
31   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   oce_co2   !: ocean carbon flux
32
33#if defined key_top 
34   !!----------------------------------------------------------------------
35   !!   'key_top'                                                 bio-model         
36   !!----------------------------------------------------------------------
37   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .TRUE.   !: TOP model
38#else
39   !!----------------------------------------------------------------------
40   !! Default option                          No bio-model light absorption     
41   !!----------------------------------------------------------------------
42   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model
43#endif
44   !!----------------------------------------------------------------------
45   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
46   !! $Id$
47   !! Software governed by the CeCILL license (see ./LICENSE)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   INTEGER FUNCTION trc_oce_alloc()
52      !!----------------------------------------------------------------------
53      !!                  ***  trc_oce_alloc  ***
54      !!----------------------------------------------------------------------
55      ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), STAT=trc_oce_alloc )
56      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
57      !
58   END FUNCTION trc_oce_alloc
59
60
61   SUBROUTINE trc_oce_rgb( prgb )
62      !!---------------------------------------------------------------------
63      !!                  ***  ROUTINE p4z_opt_init  ***
64      !!
65      !! ** Purpose :   Initialization of of the optical scheme
66      !!
67      !! ** Method  :   Set a look up table for the optical coefficients
68      !!                i.e. the attenuation coefficient for R-G-B light
69      !!                tabulated in Chlorophyll class (from JM Andre)
70      !!
71      !! ** Action  :   prgb(3,61) tabulated R-G-B attenuation coef.
72      !!
73      !! Reference  : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
74      !!----------------------------------------------------------------------
75      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
76      !
77      INTEGER  ::   jc     ! dummy loop indice
78      INTEGER  ::   irgb   ! temporary integer
79      REAL(wp) ::   zchl   ! temporary scalar
80      REAL(wp), DIMENSION(4,61) ::   zrgb   ! tabulated attenuation coefficient (formerly read in 'kRGB61.txt')
81      !!----------------------------------------------------------------------
82      !
83      IF(lwp) THEN
84         WRITE(numout,*)
85         WRITE(numout,*) '   trc_oce_rgb : Initialisation of the optical look-up table'
86         WRITE(numout,*) '   ~~~~~~~~~~~ '
87      ENDIF
88      !
89      !  Chlorophyll        !     Blue attenuation     !     Green attenuation    !     Red attenuation      !
90      zrgb(1, 1) =  0.010   ;   zrgb(2, 1) = 0.01618   ;   zrgb(3, 1) = 0.07464   ;   zrgb(4, 1) = 0.37807
91      zrgb(1, 2) =  0.011   ;   zrgb(2, 2) = 0.01654   ;   zrgb(3, 2) = 0.07480   ;   zrgb(4, 2) = 0.37823
92      zrgb(1, 3) =  0.013   ;   zrgb(2, 3) = 0.01693   ;   zrgb(3, 3) = 0.07499   ;   zrgb(4, 3) = 0.37840
93      zrgb(1, 4) =  0.014   ;   zrgb(2, 4) = 0.01736   ;   zrgb(3, 4) = 0.07518   ;   zrgb(4, 4) = 0.37859
94      zrgb(1, 5) =  0.016   ;   zrgb(2, 5) = 0.01782   ;   zrgb(3, 5) = 0.07539   ;   zrgb(4, 5) = 0.37879
95      zrgb(1, 6) =  0.018   ;   zrgb(2, 6) = 0.01831   ;   zrgb(3, 6) = 0.07562   ;   zrgb(4, 6) = 0.37900
96      zrgb(1, 7) =  0.020   ;   zrgb(2, 7) = 0.01885   ;   zrgb(3, 7) = 0.07586   ;   zrgb(4, 7) = 0.37923
97      zrgb(1, 8) =  0.022   ;   zrgb(2, 8) = 0.01943   ;   zrgb(3, 8) = 0.07613   ;   zrgb(4, 8) = 0.37948
98      zrgb(1, 9) =  0.025   ;   zrgb(2, 9) = 0.02005   ;   zrgb(3, 9) = 0.07641   ;   zrgb(4, 9) = 0.37976
99      zrgb(1,10) =  0.028   ;   zrgb(2,10) = 0.02073   ;   zrgb(3,10) = 0.07672   ;   zrgb(4,10) = 0.38005
100      zrgb(1,11) =  0.032   ;   zrgb(2,11) = 0.02146   ;   zrgb(3,11) = 0.07705   ;   zrgb(4,11) = 0.38036
101      zrgb(1,12) =  0.035   ;   zrgb(2,12) = 0.02224   ;   zrgb(3,12) = 0.07741   ;   zrgb(4,12) = 0.38070
102      zrgb(1,13) =  0.040   ;   zrgb(2,13) = 0.02310   ;   zrgb(3,13) = 0.07780   ;   zrgb(4,13) = 0.38107
103      zrgb(1,14) =  0.045   ;   zrgb(2,14) = 0.02402   ;   zrgb(3,14) = 0.07821   ;   zrgb(4,14) = 0.38146
104      zrgb(1,15) =  0.050   ;   zrgb(2,15) = 0.02501   ;   zrgb(3,15) = 0.07866   ;   zrgb(4,15) = 0.38189
105      zrgb(1,16) =  0.056   ;   zrgb(2,16) = 0.02608   ;   zrgb(3,16) = 0.07914   ;   zrgb(4,16) = 0.38235
106      zrgb(1,17) =  0.063   ;   zrgb(2,17) = 0.02724   ;   zrgb(3,17) = 0.07967   ;   zrgb(4,17) = 0.38285
107      zrgb(1,18) =  0.071   ;   zrgb(2,18) = 0.02849   ;   zrgb(3,18) = 0.08023   ;   zrgb(4,18) = 0.38338
108      zrgb(1,19) =  0.079   ;   zrgb(2,19) = 0.02984   ;   zrgb(3,19) = 0.08083   ;   zrgb(4,19) = 0.38396
109      zrgb(1,20) =  0.089   ;   zrgb(2,20) = 0.03131   ;   zrgb(3,20) = 0.08149   ;   zrgb(4,20) = 0.38458
110      zrgb(1,21) =  0.100   ;   zrgb(2,21) = 0.03288   ;   zrgb(3,21) = 0.08219   ;   zrgb(4,21) = 0.38526
111      zrgb(1,22) =  0.112   ;   zrgb(2,22) = 0.03459   ;   zrgb(3,22) = 0.08295   ;   zrgb(4,22) = 0.38598
112      zrgb(1,23) =  0.126   ;   zrgb(2,23) = 0.03643   ;   zrgb(3,23) = 0.08377   ;   zrgb(4,23) = 0.38676
113      zrgb(1,24) =  0.141   ;   zrgb(2,24) = 0.03842   ;   zrgb(3,24) = 0.08466   ;   zrgb(4,24) = 0.38761
114      zrgb(1,25) =  0.158   ;   zrgb(2,25) = 0.04057   ;   zrgb(3,25) = 0.08561   ;   zrgb(4,25) = 0.38852
115      zrgb(1,26) =  0.178   ;   zrgb(2,26) = 0.04289   ;   zrgb(3,26) = 0.08664   ;   zrgb(4,26) = 0.38950
116      zrgb(1,27) =  0.200   ;   zrgb(2,27) = 0.04540   ;   zrgb(3,27) = 0.08775   ;   zrgb(4,27) = 0.39056
117      zrgb(1,28) =  0.224   ;   zrgb(2,28) = 0.04811   ;   zrgb(3,28) = 0.08894   ;   zrgb(4,28) = 0.39171
118      zrgb(1,29) =  0.251   ;   zrgb(2,29) = 0.05103   ;   zrgb(3,29) = 0.09023   ;   zrgb(4,29) = 0.39294
119      zrgb(1,30) =  0.282   ;   zrgb(2,30) = 0.05420   ;   zrgb(3,30) = 0.09162   ;   zrgb(4,30) = 0.39428
120      zrgb(1,31) =  0.316   ;   zrgb(2,31) = 0.05761   ;   zrgb(3,31) = 0.09312   ;   zrgb(4,31) = 0.39572
121      zrgb(1,32) =  0.355   ;   zrgb(2,32) = 0.06130   ;   zrgb(3,32) = 0.09474   ;   zrgb(4,32) = 0.39727
122      zrgb(1,33) =  0.398   ;   zrgb(2,33) = 0.06529   ;   zrgb(3,33) = 0.09649   ;   zrgb(4,33) = 0.39894
123      zrgb(1,34) =  0.447   ;   zrgb(2,34) = 0.06959   ;   zrgb(3,34) = 0.09837   ;   zrgb(4,34) = 0.40075
124      zrgb(1,35) =  0.501   ;   zrgb(2,35) = 0.07424   ;   zrgb(3,35) = 0.10040   ;   zrgb(4,35) = 0.40270
125      zrgb(1,36) =  0.562   ;   zrgb(2,36) = 0.07927   ;   zrgb(3,36) = 0.10259   ;   zrgb(4,36) = 0.40480
126      zrgb(1,37) =  0.631   ;   zrgb(2,37) = 0.08470   ;   zrgb(3,37) = 0.10495   ;   zrgb(4,37) = 0.40707
127      zrgb(1,38) =  0.708   ;   zrgb(2,38) = 0.09056   ;   zrgb(3,38) = 0.10749   ;   zrgb(4,38) = 0.40952
128      zrgb(1,39) =  0.794   ;   zrgb(2,39) = 0.09690   ;   zrgb(3,39) = 0.11024   ;   zrgb(4,39) = 0.41216
129      zrgb(1,40) =  0.891   ;   zrgb(2,40) = 0.10374   ;   zrgb(3,40) = 0.11320   ;   zrgb(4,40) = 0.41502
130      zrgb(1,41) =  1.000   ;   zrgb(2,41) = 0.11114   ;   zrgb(3,41) = 0.11639   ;   zrgb(4,41) = 0.41809
131      zrgb(1,42) =  1.122   ;   zrgb(2,42) = 0.11912   ;   zrgb(3,42) = 0.11984   ;   zrgb(4,42) = 0.42142
132      zrgb(1,43) =  1.259   ;   zrgb(2,43) = 0.12775   ;   zrgb(3,43) = 0.12356   ;   zrgb(4,43) = 0.42500
133      zrgb(1,44) =  1.413   ;   zrgb(2,44) = 0.13707   ;   zrgb(3,44) = 0.12757   ;   zrgb(4,44) = 0.42887
134      zrgb(1,45) =  1.585   ;   zrgb(2,45) = 0.14715   ;   zrgb(3,45) = 0.13189   ;   zrgb(4,45) = 0.43304
135      zrgb(1,46) =  1.778   ;   zrgb(2,46) = 0.15803   ;   zrgb(3,46) = 0.13655   ;   zrgb(4,46) = 0.43754
136      zrgb(1,47) =  1.995   ;   zrgb(2,47) = 0.16978   ;   zrgb(3,47) = 0.14158   ;   zrgb(4,47) = 0.44240
137      zrgb(1,48) =  2.239   ;   zrgb(2,48) = 0.18248   ;   zrgb(3,48) = 0.14701   ;   zrgb(4,48) = 0.44765
138      zrgb(1,49) =  2.512   ;   zrgb(2,49) = 0.19620   ;   zrgb(3,49) = 0.15286   ;   zrgb(4,49) = 0.45331
139      zrgb(1,50) =  2.818   ;   zrgb(2,50) = 0.21102   ;   zrgb(3,50) = 0.15918   ;   zrgb(4,50) = 0.45942
140      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601
141      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313
142      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080
143      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909
144      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803
145      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768
146      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810
147      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934
148      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147
149      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457
150      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870
151      !
152      prgb(:,:) = zrgb(2:4,:)
153      !
154      r_si2 = 1.e0 / zrgb(2, 1)        ! blue with the smallest chlorophyll concentration)
155      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
156      !
157      DO jc = 1, 61                         ! check
158         zchl = zrgb(1,jc)
159         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
160         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
161         IF( irgb /= jc ) THEN
162            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
163            CALL ctl_stop( 'trc_oce_rgb : inconsistency in Chl tabulated attenuation coeff.' )
164         ENDIF
165      END DO
166      !
167   END SUBROUTINE trc_oce_rgb
168
169
170   SUBROUTINE trc_oce_rgb_read( prgb )
171      !!----------------------------------------------------------------------
172      !!                  ***  ROUTINE p4z_opt_init  ***
173      !!
174      !! ** Purpose :   Initialization of of the optical scheme
175      !!
176      !! ** Method  :   read the look up table for the optical coefficients
177      !!
178      !! ** input   :   xkrgb(61) precomputed array corresponding to the 
179      !!                          attenuation coefficient (from JM Andre)
180      !!----------------------------------------------------------------------
181      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
182      !
183      INTEGER  ::   jc, jb ! dummy loop indice
184      INTEGER  ::   irgb   ! temporary integer
185      REAL(wp) ::   zchl   ! temporary scalar
186      INTEGER  ::   numlight
187      !!----------------------------------------------------------------------
188      !
189      IF(lwp) THEN                         ! control print
190         WRITE(numout,*)
191         WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
192         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
193         WRITE(numout,*) 
194      ENDIF
195      !
196      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
197      DO jc = 1, 61
198         READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 )
199         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )   
200         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb 
201         IF( irgb /= jc ) THEN 
202            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
203            CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' )
204         ENDIF
205      END DO
206      CLOSE( numlight )
207      !
208      r_si2 = 1.e0 / prgb(1, 1)      ! blue with the smallest chlorophyll concentration)
209      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
210      !
211   END SUBROUTINE trc_oce_rgb_read
212
213
214   FUNCTION trc_oce_ext_lev( prldex, pqsr_frc ) RESULT( pjl )
215      !!----------------------------------------------------------------------
216      !!                 ***  ROUTINE trc_oce_ext_lev  ***
217      !!       
218      !! ** Purpose :   compute max. level for light penetration
219      !!         
220      !! ** Method  :   the function provides the level at which irradiance
221      !!                becomes negligible (i.e. = 1.e-15 W/m2) for 3 or 2 bands light
222      !!                penetration: I(z) = pqsr_frc * EXP(hext/prldex) = 1.e-15 W/m2
223      !!                # prldex is the longest depth of extinction:
224      !!                   - prldex = 23 m (2 bands case)
225      !!                   - prldex = 62 m (3 bands case: blue waveband & 0.01 mg/m2 for the chlorophyll)
226      !!                # pqsr_frc is the fraction of solar radiation which penetrates,
227      !!                considering Qsr=240 W/m2 and rn_abs = 0.58:
228      !!                   - pqsr_frc = Qsr * (1-rn_abs)   = 1.00e2 W/m2 (2 bands case)
229      !!                   - pqsr_frc = Qsr * (1-rn_abs)/3 = 0.33e2 W/m2 (3 bands case & equi-partition)
230      !!
231      !!----------------------------------------------------------------------
232      REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction
233      REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates
234      !
235      INTEGER  ::   jk, pjl            ! levels
236      REAL(wp) ::   zhext              ! deepest level till which light penetrates
237      REAL(wp) ::   zprec = 15._wp     ! precision to reach -LOG10(1.e-15)
238      REAL(wp) ::   zem                ! temporary scalar
239      !!----------------------------------------------------------------------
240      !
241      ! It is not necessary to compute anything below the following depth
242      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
243      !
244      ! Level of light extinction
245      pjl = jpkm1
246      DO jk = jpkm1, 1, -1
247         IF(SUM(tmask(:,:,jk)) > 0 ) THEN
248            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) )
249            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
250         ELSE
251            pjl = jk                                            ! or regional sea-bed depth
252         ENDIF
253      END DO
254      !
255   END FUNCTION trc_oce_ext_lev
256
257   !!======================================================================
258END MODULE trc_oce
Note: See TracBrowser for help on using the repository browser.