Newer
Older
MODULE usrdef_istate
!!======================================================================
!! *** MODULE usrdef_istate ***
!!
!! === WAD_TEST_CASES configuration ===
!!
!! User defined : set the initial state of a user configuration
!!======================================================================
!! History : 4.0 ! 2016-03 (S. Flavoni) Original code
!! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! usr_def_istate : initial state in Temperature and salinity
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE wet_dry ! Wetting and drying
!
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
IMPLICIT NONE
PRIVATE
PUBLIC usr_def_istate ! called in istate.F90
PUBLIC usr_def_istate_ssh ! called in sshwzv.F90
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: usrdef_istate.F90 14053 2020-12-03 13:48:38Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv )
!!----------------------------------------------------------------------
!! *** ROUTINE usr_def_istate ***
!!
!! ** Purpose : Initialization of the dynamics and tracers
!! Here WAD_TEST_CASES configuration
!!
!! ** Method : - set temprature field
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
!! - set salinity field
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m]
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pts ! T & S fields [Celsius ; g/kg]
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s]
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zi, zj
!
INTEGER :: jk ! dummy loop indices
REAL(wp) :: zdam ! location of dam [Km]
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD_TEST_CASES configuration, analytical definition of initial state'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with a constant temperature '
IF(lwp) WRITE(numout,*) ' and constant salinity (not used as rho=F(T) '
!
!
pu (:,:,:) = 0._wp ! ocean at rest
pv (:,:,:) = 0._wp
! ! T & S profiles
pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)
!
pts(:,:,:,jp_sal) = 35._wp * ptmask(:,:,:)
!!----------------------------------------------------------------------
!
!!----------------------------------------------------------------------
!
! Uniform T & S in most test cases
pts(:,:,:,jp_tem) = 10._wp
pts(:,:,:,jp_sal) = 35._wp
SELECT CASE ( nn_cfg )
! ! ====================
CASE ( 1 ) ! WAD 1 configuration
! ! ====================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
! ! ====================
CASE ( 2, 8 ) ! WAD 2 configuration
! ! ====================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
! ! ====================
CASE ( 3 ) ! WAD 3 configuration
! ! ====================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
! ! ====================
CASE ( 4 ) ! WAD 4 configuration
! ! ====================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
! ! ===========================
CASE ( 5, 7 ) ! WAD 5 and 7 configurations
! ! ===========================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
! ! ====================
CASE ( 6 ) ! WAD 6 configuration
! ! ====================
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
pts(ji,:,:,jp_sal) = 30._wp
END DO
!
!
! ! ===========================
CASE DEFAULT ! NONE existing configuration
! ! ===========================
WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
!
CALL ctl_stop( ctmp1 )
!
END SELECT
!
END SUBROUTINE usr_def_istate
SUBROUTINE usr_def_istate_ssh( ptmask, pssh )
!!----------------------------------------------------------------------
!! *** ROUTINE usr_def_istate_ssh ***
!!
!! ** Purpose : Initialization of the dynamics and tracers
!! Here WAD_TEST_CASES configuration
!!
!! ** Method : - set ssh
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zi, zj
!
INTEGER :: jk ! dummy loop indices
REAL(wp) :: zdam ! location of dam [Km]
!!----------------------------------------------------------------------
!
!
SELECT CASE ( nn_cfg )
! ! ====================
CASE ( 1 ) ! WAD 1 configuration
! ! ====================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1,jpi
pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
END DO
! ! ====================
CASE ( 2, 8 ) ! WAD 2 configuration
! ! ====================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1,jpi
pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
END DO
! ! ====================
CASE ( 3 ) ! WAD 3 configuration
! ! ====================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1,jpi
pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
END DO
!
! ! ====================
CASE ( 4 ) ! WAD 4 configuration
! ! ====================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1, jpi
zi = MAX(1.0-((glamt(ji,1)-25._wp)**2)/400.0, 0.0 )
DO jj = 1, jpj
zj = MAX(1.0-((gphit(1,jj)-17._wp)**2)/144.0, 0.0 )
pssh(ji,jj) = -2.5_wp + 5.4_wp*zi*zj
END DO
END DO
!
! ! ===========================
CASE ( 5, 7 ) ! WAD 5 and 7 configurations
! ! ===========================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1,jpi
pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
END DO
!
! ! ====================
CASE ( 6 ) ! WAD 6 configuration
! ! ====================
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
DO ji = 1,jpi
pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1)
END DO
!
DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
pssh(ji,:) = -0.1*ptmask(ji,:,1)
END DO
!
!
! ! ===========================
CASE DEFAULT ! NONE existing configuration
! ! ===========================
WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
!
CALL ctl_stop( ctmp1 )
!
END SELECT
!
! Apply minimum wetdepth criterion
!
DO_2D( 1, 1, 1, 1 )
IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN
pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) )
ENDIF
END_2D
!
END SUBROUTINE usr_def_istate_ssh
!!======================================================================
END MODULE usrdef_istate