Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
MODULE trcdmp_sed
!!======================================================================
!! *** MODULE trcdmp ***
!! Ocean physics: internal restoring trend on passive tracers
!!======================================================================
!! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code
!! ! 1996-01 (G. Madec) statement function for e3
!! ! 1997-05 (H. Loukos) adapted for passive tracers
!! NEMO 9.0 ! 2004-03 (C. Ethe) free form + modules
!! 3.2 ! 2007-02 (C. Deltel) Diagnose ML trends for passive tracers
!! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
!! trc_dmp : update the tracer trend with the internal damping
!! trc_dmp_init : initialization, namlist read, parameters control
!!----------------------------------------------------------------------
USE oce_trc ! ocean dynamics and tracers variables
USE trc ! ocean passive tracers variables
USE sed , ONLY : dtsed => dtsed ! ocean dynamics and tracers variables
USE trc ! ocean passive tracers variables
USE trcdta
USE prtctl ! Print control for debbuging
USE iom
IMPLICIT NONE
PRIVATE
PUBLIC trc_dmp_sed
PUBLIC trc_dmp_sed_alloc
PUBLIC trc_dmp_sed_ini
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restosed ! restoring coeff. on tracers (s-1)
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
!! $Id: trcdmp.F90 7646 2017-02-06 09:25:03Z timgraham $
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
INTEGER FUNCTION trc_dmp_sed_alloc()
!!----------------------------------------------------------------------
!! *** ROUTINE trc_dmp_alloc ***
!!----------------------------------------------------------------------
ALLOCATE( restosed(jpi,jpj,jpk) , STAT=trc_dmp_sed_alloc )
!
IF( trc_dmp_sed_alloc /= 0 ) CALL ctl_warn('trc_dmp_sed_alloc: failed to allocate array')
!
END FUNCTION trc_dmp_sed_alloc
SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_dmp_sed ***
!!
!! ** Purpose : Compute the passive tracer trend due to a newtonian damping
!! of the tracer field towards given data field and add it to the
!! general tracer trends.
!!
!! ** Method : Newtonian damping towards trdta computed
!! and add to the general tracer trends:
!! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb))
!! The trend is computed either throughout the water column
!! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
!! below the well mixed layer (nlmdmptr=2)
!!
!! ** Action : - update the tracer trends tr(Krhs) with the newtonian
!! damping trends.
!! - save the trends ('key_trdmxl_trc')
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level index
!
INTEGER :: ji, jj, jk, jn, jl, ikt ! dummy loop indices
CHARACTER (len=22) :: charout
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcdta ! 3D workspace
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_dmp_sed')
!
!
IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
!
DO jn = 1, jptra ! tracer loop
! ! ===========
IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
!
jl = n_trc_index(jn)
CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
ikt = mbkt(ji,jj)
tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) &
& * exp( -restosed(ji,jj,ikt) * dtsed )
END_2D
!
ENDIF
END DO ! tracer loop
! ! ===========
ENDIF
!
! ! print mean trends (used for debugging)
IF( sn_cfctl%l_prttrc ) THEN
WRITE(charout, FMT="('dmp ')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm,clinfo3='trd' )
ENDIF
!
IF( ln_timing ) CALL timing_stop('trc_dmp_sed')
!
END SUBROUTINE trc_dmp_sed
SUBROUTINE trc_dmp_sed_ini
!!----------------------------------------------------------------------
!! *** ROUTINE trc_dmp_ini ***
!!
!! ** Purpose : Initialization for the newtonian damping
!!
!! ** Method : read the nammbf namelist and check the parameters
!! called by trc_dmp at the first timestep (nittrc000)
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_dmp_sed_ini')
IF (lwp) WRITE(numout,*) ' tracer damping throughout the water column'
!
IF( trc_dmp_sed_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_sed_ini: unable to allocate arrays' )
!
IF( .NOT.ln_c1d ) THEN
!Read in mask from file
restosed(:,:,:) = 0.5 / rday
!
ENDIF
IF( ln_timing ) CALL timing_stop('trc_dmp_sed_ini')
!
END SUBROUTINE trc_dmp_sed_ini
#else
!!----------------------------------------------------------------------
!! Dummy module : No passive tracer
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) ! Empty routine
INTEGER, INTENT(in) :: kt
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs
WRITE(*,*) 'trc_dmp_sed: You should not have seen this print! error?', kt
END SUBROUTINE trc_dmp_sed
#endif
!!======================================================================
END MODULE trcdmp_sed