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.
trcsbcssr.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbcssr.F90 @ 11063

Last change on this file since 11063 was 11063, checked in by dford, 5 years ago

Add missing lbc_lnk and option to relax chlorophyll to climatology. See Met Office utils ticket 216.
File size: 23.3 KB
Line 
1MODULE trcsbcssr
2   !!======================================================================
3   !!                       ***  MODULE  trcsbcssr  ***
4   !! Surface module :  restoring term towards surface chlorophyll climatology
5   !!======================================================================
6   !! History :  3.6  !  2017-06  (D. Ford)  Adapt from sbcssr.F90
7   !!                 !  2019-04  (D. Ford)  Add biomass balancing and error checking
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   trc_sbc_ssr       : add a restoring term toward chl climatology
12   !!   trc_sbc_ssr_init  : initialisation of surface restoring
13   !!----------------------------------------------------------------------
14   USE dom_oce        ! ocean space and time domain
15   USE oce_trc       !  shared variables between ocean and passive tracers
16   USE trc
17   USE trcnam_trp
18   !
19   USE fldread        ! read input fields
20   USE iom            ! I/O manager
21   USE in_out_manager ! I/O manager
22   USE lib_mpp        ! distribued memory computing library
23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
24   USE timing         ! Timing
25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
26#if defined key_fabm
27   USE par_fabm
28#endif
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   trc_sbc_ssr        ! routine called in trctrp
34
35   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chldmp   ! structure of input Chl (file informations, fields read)
36
37   !! * Substitutions
38#  include "top_substitute.h90"
39
40CONTAINS
41
42   SUBROUTINE trc_sbc_ssr( kt )
43      !!---------------------------------------------------------------------
44      !!                     ***  ROUTINE trc_sbc_ssr  ***
45      !!
46      !! ** Purpose :   Add to chlorophyll a damping term
47      !!                toward chlorophyll climatology
48      !!
49      !! ** Method  : - Read chlorophyll climatology
50      !!              - at each trc time step add term to each PFT
51      !!                   surface only    (nn_chldmp = 1)
52      !!                   mixed layer     (nn_chldmp = 2)
53      !!              - balance biomass variables
54      !!---------------------------------------------------------------------
55      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
56      !!
57      INTEGER  ::   ji, jj, jk   ! dummy loop indices
58 
59      REAL(wp), DIMENSION(jpi,jpj)           :: zdiff, zchl
60      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra_save, ztra_new
61      REAL(wp)                               :: zpft, zrat, zinc
62      REAL(wp)                               :: zmax_chl, zmax_c, zmax_n, zmax_p, zmax_s
63      INTEGER                                :: inum
64      !!----------------------------------------------------------------------
65      !
66      IF( nn_timing == 1 )  CALL timing_start('trc_sbc_ssr')
67      !
68      ! Maximum permitted (absolute) updates to phytoplankton variables
69      zmax_chl = 0.01
70      zmax_c   = 0.1
71      zmax_n   = 0.01
72      zmax_p   = 0.001
73      zmax_s   = 0.01
74     
75      IF( kt == nittrc000 )  THEN
76         !
77         CALL trc_sbc_ssr_init
78         !
79         IF( nn_chldmp > 0 ) THEN
80            !
81            IF (lwp) WRITE(numout,*) 'Damping chlorophyll on timestep ', kt
82           
83            ztra_save(:,:,:,:) = tra(:,:,:,:)
84            !
85            CALL fld_read( kt, 1, sf_chldmp )   ! Read Chl data and provides it at kt
86            !
87#if defined key_fabm
88            zchl(:,:) = trb(:,:,1,jp_fabm_m1+jp_fabm_chl1) + &
89               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &
90               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl3) + &
91               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl4)
92            zdiff(:,:) = rn_chldmp * ( sf_chldmp(1)%fnow(:,:,1) - zchl(:,:) )
93            !
94            DO jj = 2, jpjm1
95               DO ji = fs_2, fs_jpim1   ! vector opt.
96                  IF ( ( sf_chldmp(1)%fnow(ji,jj,1) >   0.0 ) .AND. &
97                     & ( sf_chldmp(1)%fnow(ji,jj,1) < 100.0 ) .AND. &
98                     & ( zchl(ji,jj)                >   0.0 ) ) THEN
99                     ! P1
100                     IF ( ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) > 0.0 ) .AND. &
101                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1c)  > 0.0 ) .AND. &
102                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1n)  > 0.0 ) .AND. &
103                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1p)  > 0.0 ) .AND. &
104                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1s)  > 0.0 ) ) THEN
105                        ! Chlorophyll
106                        zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / zchl(ji,jj) ) * zdiff(ji,jj)
107                        zpft = MAX( -1.0 * zmax_chl, MIN( zpft, zmax_chl ) )
108                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + zpft
109                        ! Carbon
110                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1c) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1)
111                        zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
112                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1c) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1c) + zinc
113                        ! Nitrogen
114                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1n) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1)
115                        zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
116                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1n) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1n) + zinc
117                        ! Phosphorus
118                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1p) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1)
119                        zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
120                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1p) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1p) + zinc
121                        ! Silicon
122                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p1s) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1)
123                        zinc = MAX( -1.0 * zmax_s, MIN( (zpft * zrat), zmax_s ) )
124                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1s) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p1s) + zinc
125                        !
126                        IF( nn_chldmp == 2 ) THEN
127                           ! Mixed layer
128                           DO jk = 2, jpkm1
129                              IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
130                                 IF ( ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) > 0.0 ) .AND. &
131                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1c)  > 0.0 ) .AND. &
132                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n)  > 0.0 ) .AND. &
133                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1p)  > 0.0 ) .AND. &
134                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1s)  > 0.0 ) ) THEN
135                                    ! Chlorophyll
136                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + zpft
137                                    ! Carbon
138                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1c) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1)
139                                    zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
140                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1c) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1c) + zinc
141                                    ! Nitrogen
142                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1)
143                                    zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
144                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) + zinc
145                                    ! Phosphorus
146                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1p) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1)
147                                    zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
148                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1p) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1p) + zinc
149                                    ! Silicon
150                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p1s) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1)
151                                    zinc = MAX( -1.0 * zmax_s, MIN( (zpft * zrat), zmax_s ) )
152                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1s) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p1s) + zinc
153                                 ENDIF
154                              ENDIF
155                           END DO
156                        ENDIF
157                     ENDIF
158                     ! P2
159                     IF ( ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) > 0.0 ) .AND. &
160                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2c)  > 0.0 ) .AND. &
161                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2n)  > 0.0 ) .AND. &
162                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2p)  > 0.0 ) ) THEN
163                        ! Chlorophyll
164                        zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / zchl(ji,jj) ) * zdiff(ji,jj)
165                        zpft = MAX( -1.0 * zmax_chl, MIN( zpft, zmax_chl ) )
166                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + zpft
167                        ! Carbon
168                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2c) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2)
169                        zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
170                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2c) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2c) + zinc
171                        ! Nitrogen
172                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2n) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2)
173                        zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
174                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2n) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2n) + zinc
175                        ! Phosphorus
176                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p2p) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2)
177                        zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
178                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2p) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p2p) + zinc
179                        !
180                        IF( nn_chldmp == 2 ) THEN
181                           ! Mixed layer
182                           DO jk = 2, jpkm1
183                              IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
184                                 IF ( ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) > 0.0 ) .AND. &
185                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2c)  > 0.0 ) .AND. &
186                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n)  > 0.0 ) .AND. &
187                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2p)  > 0.0 ) ) THEN
188                                    ! Chlorophyll
189                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + zpft
190                                    ! Carbon
191                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2c) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2)
192                                    zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
193                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2c) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2c) + zinc
194                                    ! Nitrogen
195                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2)
196                                    zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
197                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) + zinc
198                                    ! Phosphorus
199                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p2p) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2)
200                                    zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
201                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2p) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p2p) + zinc
202                                 ENDIF
203                              ENDIF
204                           END DO
205                        ENDIF
206                     ENDIF
207                     ! P3
208                     IF ( ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) > 0.0 ) .AND. &
209                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3c)  > 0.0 ) .AND. &
210                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3n)  > 0.0 ) .AND. &
211                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3p)  > 0.0 ) ) THEN
212                        ! Chlorophyll
213                        zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / zchl(ji,jj) ) * zdiff(ji,jj)
214                        zpft = MAX( -1.0 * zmax_chl, MIN( zpft, zmax_chl ) )
215                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + zpft
216                        ! Carbon
217                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3c) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3)
218                        zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
219                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3c) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3c) + zinc
220                        ! Nitrogen
221                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3n) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3)
222                        zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
223                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3n) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3n) + zinc
224                        ! Phosphorus
225                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p3p) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3)
226                        zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
227                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3p) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p3p) + zinc
228                        !
229                        IF( nn_chldmp == 2 ) THEN
230                           ! Mixed layer
231                           DO jk = 2, jpkm1
232                              IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
233                                 IF ( ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) > 0.0 ) .AND. &
234                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3c)  > 0.0 ) .AND. &
235                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n)  > 0.0 ) .AND. &
236                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3p)  > 0.0 ) ) THEN
237                                    ! Chlorophyll
238                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + zpft
239                                    ! Carbon
240                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3c) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3)
241                                    zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
242                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3c) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3c) + zinc
243                                    ! Nitrogen
244                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3)
245                                    zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
246                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) + zinc
247                                    ! Phosphorus
248                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p3p) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3)
249                                    zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
250                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3p) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p3p) + zinc
251                                 ENDIF
252                              ENDIF
253                           END DO
254                        ENDIF
255                     ENDIF
256                     ! P4
257                     IF ( ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) > 0.0 ) .AND. &
258                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4c)  > 0.0 ) .AND. &
259                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4n)  > 0.0 ) .AND. &
260                        & ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4p)  > 0.0 ) ) THEN
261                        ! Chlorophyll
262                        zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / zchl(ji,jj) ) * zdiff(ji,jj)
263                        zpft = MAX( -1.0 * zmax_chl, MIN( zpft, zmax_chl ) )
264                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + zpft
265                        ! Carbon
266                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4c) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4)
267                        zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
268                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4c) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4c) + zinc
269                        ! Nitrogen
270                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4n) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4)
271                        zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
272                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4n) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4n) + zinc
273                        ! Phosphorus
274                        zrat = trb(ji,jj,1,jp_fabm_m1+jp_fabm_p4p) / trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4)
275                        zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
276                        tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4p) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_p4p) + zinc
277                        !
278                        IF( nn_chldmp == 2 ) THEN
279                           ! Mixed layer
280                           DO jk = 2, jpkm1
281                              IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
282                                 IF ( ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) > 0.0 ) .AND. &
283                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4c)  > 0.0 ) .AND. &
284                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n)  > 0.0 ) .AND. &
285                                    & ( trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4p)  > 0.0 ) ) THEN
286                                    ! Chlorophyll
287                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) + zpft
288                                    ! Carbon
289                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4c) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4)
290                                    zinc = MAX( -1.0 * zmax_c, MIN( (zpft * zrat), zmax_c ) )
291                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4c) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4c) + zinc
292                                    ! Nitrogen
293                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4)
294                                    zinc = MAX( -1.0 * zmax_n, MIN( (zpft * zrat), zmax_n ) )
295                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) + zinc
296                                    ! Phosphorus
297                                    zrat = trb(ji,jj,jk,jp_fabm_m1+jp_fabm_p4p) / trb(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4)
298                                    zinc = MAX( -1.0 * zmax_p, MIN( (zpft * zrat), zmax_p ) )
299                                    tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4p) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_p4p) + zinc
300                                 ENDIF
301                              ENDIF
302                           END DO
303                        ENDIF
304                     ENDIF
305                  ENDIF
306               END DO
307            END DO
308           
309            ! Save updates
310            ztra_new(:,:,:,:) = tra(:,:,:,:) - ztra_save(:,:,:,:)
311            CALL iom_open( 'chldmp.balincs', inum, ldwrt = .TRUE., kiolib = jprstlib)
312            zdiff(:,:) = zdiff(:,:) * tmask(:,:,1)
313            CALL iom_rstput( kt, kt, inum, 'ChlTot', zdiff(:,:) )
314            CALL iom_rstput( kt, kt, inum, 'P1_Chl', ztra_new(:,:,:,jp_fabm_chl1) )
315            CALL iom_rstput( kt, kt, inum, 'P1_c',   ztra_new(:,:,:,jp_fabm_p1c)  )
316            CALL iom_rstput( kt, kt, inum, 'P1_n',   ztra_new(:,:,:,jp_fabm_p1n)  )
317            CALL iom_rstput( kt, kt, inum, 'P1_p',   ztra_new(:,:,:,jp_fabm_p1p)  )
318            CALL iom_rstput( kt, kt, inum, 'P1_s',   ztra_new(:,:,:,jp_fabm_p1s)  )
319            CALL iom_rstput( kt, kt, inum, 'P2_Chl', ztra_new(:,:,:,jp_fabm_chl2) )
320            CALL iom_rstput( kt, kt, inum, 'P2_c',   ztra_new(:,:,:,jp_fabm_p2c)  )
321            CALL iom_rstput( kt, kt, inum, 'P2_n',   ztra_new(:,:,:,jp_fabm_p2n)  )
322            CALL iom_rstput( kt, kt, inum, 'P2_p',   ztra_new(:,:,:,jp_fabm_p2p)  )
323            CALL iom_rstput( kt, kt, inum, 'P3_Chl', ztra_new(:,:,:,jp_fabm_chl3) )
324            CALL iom_rstput( kt, kt, inum, 'P3_c',   ztra_new(:,:,:,jp_fabm_p3c)  )
325            CALL iom_rstput( kt, kt, inum, 'P3_n',   ztra_new(:,:,:,jp_fabm_p3n)  )
326            CALL iom_rstput( kt, kt, inum, 'P3_p',   ztra_new(:,:,:,jp_fabm_p3p)  )
327            CALL iom_rstput( kt, kt, inum, 'P4_Chl', ztra_new(:,:,:,jp_fabm_chl4) )
328            CALL iom_rstput( kt, kt, inum, 'P4_c',   ztra_new(:,:,:,jp_fabm_p4c)  )
329            CALL iom_rstput( kt, kt, inum, 'P4_n',   ztra_new(:,:,:,jp_fabm_p4n)  )
330            CALL iom_rstput( kt, kt, inum, 'P4_p',   ztra_new(:,:,:,jp_fabm_p4p)  )
331            CALL iom_close( inum )
332#else
333            CALL ctl_stop( 'STOP', 'trc_sbc_ssr: only works with FABM-ERSEM' )
334#endif
335            !
336         ENDIF
337         !
338      ENDIF
339      !
340      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc_ssr')
341      !
342   END SUBROUTINE trc_sbc_ssr
343
344 
345   SUBROUTINE trc_sbc_ssr_init
346      !!---------------------------------------------------------------------
347      !!                  ***  ROUTINE trc_sbc_ssr_init  ***
348      !!
349      !! ** Purpose :   initialisation of surface damping term
350      !!
351      !! ** Method  : - Read chlorophyll
352      !!---------------------------------------------------------------------
353      INTEGER  ::   ierror   ! return error code
354      !!----------------------------------------------------------------------
355      !
356      IF( nn_chldmp > 0 ) THEN      !* set sf_sss structure & allocate arrays
357         !
358         ALLOCATE( sf_chldmp(1), STAT=ierror )
359         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp structure' )
360         ALLOCATE( sf_chldmp(1)%fnow(jpi,jpj,1), STAT=ierror )
361         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp now array' )
362         !
363         ! fill sf_sss with sn_sss and control print
364         CALL fld_fill( sf_chldmp, (/ sn_chldmp /), cn_dir_chldmp, 'trc_sbc_ssr', 'Chl restoring term', 'namtrc_dmp' )
365         IF( sf_chldmp(1)%ln_tint )   ALLOCATE( sf_chldmp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
366         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp data array' )
367         !
368      ENDIF
369      !
370   END SUBROUTINE trc_sbc_ssr_init
371
372#else
373   SUBROUTINE trc_sbc_ssr( kt )        ! Empty routine
374      INTEGER, INTENT(in) :: kt
375      WRITE(*,*) 'trc_sbc_ssr: You should not have seen this print! error?', kt
376   END SUBROUTINE trc_sbc_ssr
377#endif
378   !!======================================================================
379END MODULE trcsbcssr
Note: See TracBrowser for help on using the repository browser.