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.
trcais.F90 in NEMO/trunk/src/TOP – NEMO

source: NEMO/trunk/src/TOP/trcais.F90

Last change on this file was 15446, checked in by cetlod, 2 years ago

Minor bugfixes mostly related to PISCES/SED module

File size: 12.4 KB
Line 
1MODULE trcais
2   !!======================================================================
3   !!                         ***  MODULE trcais  ***
4   !!  Module for passive tracers in Antarctic ice sheet
5   !!  delivered by iceberg and ice shelf freshwater fluxes
6   !!======================================================================
7   !! History :  1.0  ! 2020    (R. Person, O. Aumont, C. Ethe),
8   !!======================================================================
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP model
12   !!----------------------------------------------------------------------
13   !!   trc_ais       : external source of tracers from Antarctic ice sheet
14   !!----------------------------------------------------------------------
15   USE par_trc        !  passive tracers parameters
16   USE oce_trc        !  shared variables between ocean and passive tracers
17   USE trc            !  passive tracers common variables
18   USE iom            !  I/O manager
19   USE lib_mpp        !  MPP library
20   USE sbc_oce        !
21   USE isf_oce        ! ice shelf melting contribution
22   USE sbcrnf         ! iceberg freshwater flux
23   USE trcnam         ! Namelist read
24   USE prtctl         ! Print control
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   trc_ais         ! called in trcstp.F90 or within TOP modules
30   PUBLIC   trc_ais_ini     ! called in trcini.F90
31
32   INTEGER  , SAVE, PUBLIC                              :: nb_trcais    ! number of tracers in AIS
33   REAL(wp) , SAVE, PUBLIC                              :: rn_icbdep    ! mean underwater depth of iceberg (in meters)
34   INTEGER  , SAVE, PUBLIC                              :: icblev       ! mean underwater depth of iceberg (in level depth)
35   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)   :: n_trc_indais ! index of tracer with AIS freswater flux
36   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)   :: rf_trafac    ! multiplicative factor for AIS tracer values
37
38   !! * Substitutions
39#  include "do_loop_substitute.h90"
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
43   !! Software governed by the CeCILL license (see ./LICENSE)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE trc_ais_ini
48      !!---------------------------------------------------------------------
49      !!                     ***  ROUTINE trc_ais_ini ***
50      !!
51      !! ** Purpose :   Initialization of passive tracers from the Antartic
52      !!                Ice Sheet delivered by iceberg and ice shelf
53      !!                freshwater flux
54      !!
55      !! ** Method  : - Read namtsd namelist
56      !!             
57      !!---------------------------------------------------------------------
58      INTEGER            :: jl, jn, jk                     ! dummy loop indices
59      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
60      INTEGER            :: ios                            ! Local integer output status for namelist read
61      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trafac    ! multiplicative factor for tracer values
62      !!
63      NAMELIST/namtrc_ais/ nn_ais_tr, rn_trafac, rn_icbdep
64      !!----------------------------------------------------------------------
65      !
66      IF( lwp ) THEN
67         WRITE(numout,*)
68         WRITE(numout,*) 'trc_ais_ini : Antarctic ice sheet tracer initialization'
69         WRITE(numout,*) '~~~~~~~~~~~~'
70      ENDIF
71      !
72      IF( .NOT. ln_rnf_icb ) THEN
73         CALL ctl_stop( 'trc_ais_ini: no iceberg freswater flux in runoff file' )   ;  RETURN
74      ENDIF
75      !
76      ! Compute the number of tracers to be initialised in iceberg and ice
77      ! shelf freshwater flux
78      ALLOCATE( n_trc_indais(jptra), STAT=ierr0 )
79      IF( ierr0 > 0 ) THEN
80         CALL ctl_stop( 'trc_ais_ini: unable to allocate n_trc_indais' )   ;  RETURN
81      ENDIF
82      nb_trcais       = 0
83      n_trc_indais(:) = 0
84      !
85      ! Read Antarctic Ice Sheet Namelist
86      READ  ( numnat_ref, namtrc_ais, IOSTAT = ios, ERR = 901)
87901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ais in reference namelist' )
88      READ  ( numnat_cfg, namtrc_ais, IOSTAT = ios, ERR = 902 )
89902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ais in configuration namelist' )
90      IF(lwm) WRITE ( numont, namtrc_ais )
91      !
92      IF( lwp ) THEN
93         WRITE(numout,*) ' '
94         WRITE(numout,*) '   Namelist : namtrc_ais'
95         WRITE(numout,*) '   Antarctic Ice Sheet tracers option (nn_ais_tr) : ', nn_ais_tr
96      ENDIF
97      ! compose AIS data indexes
98      DO jn = 1, jptra
99         IF( ln_trc_ais(jn) ) THEN
100             nb_trcais       = nb_trcais + 1   ;   n_trc_indais(jn) = nb_trcais
101         ENDIF
102      END DO
103
104      ! Print summmary of Antarctic Ice Sheet tracers supply
105      IF( lwp ) THEN
106         WRITE(numout,*)
107         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with AIS freshwater fluxes:', nb_trcais
108      ENDIF
109      !
110      IF( nb_trcais > 0 ) THEN
111         ALLOCATE( rf_trafac(nb_trcais), STAT=ierr0 )
112         DO jn = 1, jptra
113            IF( ln_trc_ais(jn) ) THEN
114                jl = n_trc_indais(jn)
115                rf_trafac(jl) = rn_trafac(jn)
116                IF(lwp) WRITE(numout, 9001) jn, ctrcnm(jn), 'AIS', rn_trafac(jn), rf_trafac(jl)
117            ENDIF
118         END DO
119      ENDIF
1209001  FORMAT(2x,i5, 8x, a15, 3x, a3, 5x, e11.3, 5x, e11.3)
121
122      !
123      icblev = 1        !  compute last level where depth less than rn_icbdep (120 m)
124         DO jk = jpkm1, 1, -1
125            IF( gdept_1d(jk) > rn_icbdep )   icblev = jk - 1
126         END DO
127         IF(lwp) WRITE(numout,*)
128         IF(lwp) WRITE(numout,*) ' Level corresponding to iceberg depth ',  icblev,' ', gdept_1d(icblev+1)
129      !
130   END SUBROUTINE trc_ais_ini
131
132   SUBROUTINE trc_ais(kt, Kmm, ptr, Krhs)
133      !!----------------------------------------------------------------------
134      !!                   ***  ROUTINE trc_ais  ***
135      !!
136      !! ** Purpose :  Apply Antarctic Ice Sheet inputs to tracers
137      !!
138      !! ** Method  :  Read freswater flux from iceberg and ice shelf
139      !!               and update data
140      !!               
141      !!----------------------------------------------------------------------
142      !!
143      INTEGER                                   , INTENT(in)           ::   kt ! ocean time-step index
144      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices
145      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout)        ::   ptr ! passive tracers and RHS of tracer equation
146      !!
147      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index
148      INTEGER  :: ikt, ikb  ! top and bottom level of the tbl
149      CHARACTER (len=22) :: charout
150      REAL(wp) :: zfact, zcalv, zfrac
151      !!---------------------------------------------------------------------
152      !
153      IF( ln_timing )   CALL timing_start('trc_ais')
154
155      IF( kt == nit000 .AND. lwp) THEN
156         WRITE(numout,*)
157         WRITE(numout,*) 'trc_ais : passive tracers from Antarctic Ice Sheet'
158         WRITE(numout,*) '~~~~~~~ '
159      ENDIF
160
161
162      ! 0. initialization
163      SELECT CASE ( nn_ais_tr )
164
165      CASE ( 0 ) ! No tracers in Antarctic Ice Sheet (null concentration in AIS)
166         !
167         ! Iceberg freshwater dilution for tracers with absent iceberg load
168         IF( ln_rnf_icb ) THEN
169            DO jn = 1, jptra
170               IF( ln_trc_ais(jn) ) THEN
171                  jl = n_trc_indais(jn)
172                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
173                     zfact = 1. / e3t(ji,jj,1,Kmm)
174                     ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact
175                  END_2D
176               END IF
177            END DO   
178         END IF   
179         ! Ice shelf freshwater dilution for tracers with absent ice shelf load
180         IF( ln_isf ) THEN
181            DO jn = 1, jptra
182               IF( ln_trc_ais(jn) ) THEN
183                  jl = n_trc_indais(jn)
184                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
185                     IF( ln_isfpar_mlt ) THEN
186                        zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
187                        ikt = misfkt_par(ji,jj)
188                        ikb = misfkb_par(ji,jj)
189                        zfrac = rfrac_tbl_par(ji,jj)
190                     END IF   
191                     IF( ln_isfcav_mlt ) THEN
192                        zcalv = fwfisf_cav(ji,jj) * r1_rho0 / rhisf_tbl_cav(ji,jj)
193                        ikt = misfkt_cav(ji,jj)
194                        ikb = misfkb_cav(ji,jj)
195                        zfrac = rfrac_tbl_cav(ji,jj)
196                     END IF   
197                     ! level fully include in the ice shelf boundary layer
198                     DO jk = ikt, ikb - 1
199                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + zcalv * ptr(ji,jj,jk,jn,Kmm)
200                     END DO
201                     ! level partially include in ice shelf boundary layer
202                     ptr(ji,jj,ikb,jn,Krhs) = ptr(ji,jj,ikb,jn,Krhs) +  zcalv * ptr(ji,jj,ikb,jn,Kmm) * zfrac 
203                  END_2D
204               ENDIF   
205            END DO
206         END IF
207         !
208      CASE ( 1 )  ! Specific treatment  with an imposed concentration in AIS
209         !
210         ! source of bgc tracers from iceberg in Southern Ocean
211         ! distributed along the water column until 120 m depth (Person et al., 2019)
212         IF( ln_rnf_icb ) THEN
213            DO jn = 1, jptra
214               IF( ln_trc_ais(jn) ) THEN
215                  jl = n_trc_indais(jn)
216                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
217                     DO jk = 1, icblev
218                        zcalv  =  fwficb(ji,jj) * r1_rho0 
219                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trafac(jl) * zcalv / gdepw(ji,jj,icblev+1,Kmm)
220                     END DO   
221                  END_2D
222                END IF 
223            END DO   
224         END IF   
225         ! source of bgc tracers from ice shelf in the Southern Ocean
226         ! with tbl treated as in Mathiot et al. (2017)
227         IF( ln_isf ) THEN
228            DO jn = 1, jptra
229               IF( ln_trc_ais(jn) ) THEN
230                  jl = n_trc_indais(jn)
231                  DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
232                     IF( ln_isfpar_mlt ) THEN
233                        zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
234                        ikt = misfkt_par(ji,jj)
235                        ikb = misfkb_par(ji,jj)
236                        zfrac = rfrac_tbl_par(ji,jj)
237                     END IF
238                     IF( ln_isfcav_mlt ) THEN
239                        zcalv = - fwfisf_cav(ji,jj) * r1_rho0 / rhisf_tbl_cav(ji,jj)
240                        ikt = misfkt_cav(ji,jj)
241                        ikb = misfkb_cav(ji,jj)
242                        zfrac = rfrac_tbl_cav(ji,jj)
243                     END IF
244                     ! level fully include in the ice shelf boundary layer
245                     DO jk = ikt, ikb - 1
246                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trafac(jl) * zcalv
247                     END DO
248                     ! level partially include in ice shelf boundary layer
249                     ptr(ji,jj,ikb,jn,Krhs) = ptr(ji,jj,ikb,jn,Krhs) + rf_trafac(jl) * zcalv * zfrac
250                  END_2D
251               ENDIF
252            END DO
253         END IF
254      END SELECT
255      !
256
257      IF( ln_timing )   CALL timing_stop('trc_ais')
258      !
259      ! for debugging
260!      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging)
261!         WRITE(charout, FMT="('ais ')")
262!         CALL prt_ctl_trc_info(charout)
263!         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
264!      ENDIF
265      !
266   END SUBROUTINE trc_ais
267
268#else
269   !!----------------------------------------------------------------------
270   !!   Dummy module                              NO 3D passive tracer data
271   !!----------------------------------------------------------------------
272CONTAINS
273   SUBROUTINE trc_ais_ini   ! Empty routine
274   END SUBROUTINE trc_ais_ini
275   SUBROUTINE trc_ais( kt, Kmm, Krhs )        ! Empty routine
276      INTEGER, INTENT(in) :: kt, Kmm, Krhs ! time level indices
277      WRITE(*,*) 'trc_ais: You should not have seen this print! error?', kt, Kmm, Krhs
278   END SUBROUTINE trc_ais
279#endif
280
281   !!======================================================================
282END MODULE trcais
Note: See TracBrowser for help on using the repository browser.