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
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
MODULE crsfld
!!======================================================================
!! *** MODULE crsdfld ***
!! Ocean coarsening : coarse ocean fields
!!=====================================================================
!! 2012-07 (J. Simeon, C. Calone, G. Madec, C. Ethe)
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! crs_fld : create the standard output files for coarse grid and prep
!! other variables needed to be passed to TOP
!!----------------------------------------------------------------------
USE crs
USE crsdom
USE crslbclnk
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
USE sbc_oce ! Surface boundary condition: ocean fields
USE zdf_oce ! vertical physics: ocean fields
USE ldftra ! ocean active tracers: lateral diffusivity & EIV coefficients
USE zdfddm ! vertical physics: double diffusion
!
USE in_out_manager ! I/O manager
USE iom !
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
USE timing ! preformance summary
IMPLICIT NONE
PRIVATE
PUBLIC crs_fld ! routines called by step.F90
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: crsfld.F90 13472 2020-09-16 13:05:19Z smasson $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE crs_fld( kt, Kmm )
!!---------------------------------------------------------------------
!! *** ROUTINE crs_fld ***
!!
!! ** Purpose : Basic output of coarsened dynamics and tracer fields
!! NETCDF format is used by default
!! 1. Accumulate in time the dimensionally-weighted fields
!! 2. At time of output, rescale [1] by dimension and time
!! to yield the spatial and temporal average.
!! See. sbcmod.F90
!!
!! ** Method :
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kmm ! time level index
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars
REAL(wp) :: zztmp ! - -
!
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt , zs , z3d
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zt_crs, zs_crs
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('crs_fld')
! Depth work arrrays
DO jk = 1 , jpk
ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
ze3u(:,:,jk) = e3u(:,:,jk,Kmm)
ze3v(:,:,jk) = e3v(:,:,jk,Kmm)
ze3w(:,:,jk) = e3w(:,:,jk,Kmm)
END DO
IF( kt == nit000 ) THEN
tsn_crs (:,:,:,:) = 0._wp ! temp/sal array, now
un_crs (:,:,: ) = 0._wp ! u-velocity
vn_crs (:,:,: ) = 0._wp ! v-velocity
wn_crs (:,:,: ) = 0._wp ! w
avs_crs (:,:,: ) = 0._wp ! avt
hdivn_crs(:,:,: ) = 0._wp ! hdiv
sshn_crs (:,: ) = 0._wp ! ssh
utau_crs (:,: ) = 0._wp ! taux
vtau_crs (:,: ) = 0._wp ! tauy
wndm_crs (:,: ) = 0._wp ! wind speed
qsr_crs (:,: ) = 0._wp ! qsr
emp_crs (:,: ) = 0._wp ! emp
emp_b_crs(:,: ) = 0._wp ! emp
rnf_crs (:,: ) = 0._wp ! runoff
fr_i_crs (:,: ) = 0._wp ! ice cover
ENDIF
CALL iom_swap( "nemo_crs" ) ! swap on the coarse grid
! 2. Coarsen fields at each time step
! --------------------------------------------------------
! Temperature
zt(:,:,:) = ts(:,:,:,jp_tem,Kmm) ; zt_crs(:,:,:) = 0._wp
CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp )
tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) ) ! temp
CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) ) ! sst
! Salinity
zs(:,:,:) = ts(:,:,:,jp_sal,Kmm) ; zs_crs(:,:,:) = 0._wp
CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp )
tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) ) ! sal
CALL iom_put( "sss" , tsn_crs(:,:,1,jp_sal) ) ! sss
! U-velocity
CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
END_3D
CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL iom_put( "uoce" , un_crs ) ! i-current
CALL iom_put( "uocet" , zt_crs ) ! uT
CALL iom_put( "uoces" , zs_crs ) ! uS
! V-velocity
CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
END_3D
CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL iom_put( "voce" , vn_crs ) ! i-current
CALL iom_put( "vocet" , zt_crs ) ! vT
CALL iom_put( "voces" , zs_crs ) ! vS
IF( iom_use( "ke") ) THEN ! kinetic energy
z3d(:,:,jk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zztmp = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
z3d(ji,jj,jk) = 0.25_wp * zztmp * ( &
& uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) &
& + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) &
& + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) &
& + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) )
END_3D
CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp )
!
CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp )
CALL iom_put( "ke", zt_crs )
ENDIF
! Horizontal divergence ( following OCE/DYN/divhor.F90 )
DO jk = 1, jpkm1
DO ji = 2, jpi_crsm1
DO jj = 2, jpj_crsm1
IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
z2dcrsu = ( un_crs(ji ,jj ,jk) * crs_surfu_wgt(ji ,jj ,jk) ) &
& - ( un_crs(ji-1,jj ,jk) * crs_surfu_wgt(ji-1,jj ,jk) )
z2dcrsv = ( vn_crs(ji ,jj ,jk) * crs_surfv_wgt(ji ,jj ,jk) ) &
& - ( vn_crs(ji ,jj-1,jk) * crs_surfv_wgt(ji ,jj-1,jk) )
!
hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
ENDIF
END DO
END DO
END DO
CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0_wp )
!
CALL iom_put( "hdiv", hdivn_crs )
! W-velocity
IF( ln_crs_wn ) THEN
CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp )
! CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
ELSE
wn_crs(:,:,jpk) = 0._wp
DO jk = jpkm1, 1, -1
wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
ENDDO
ENDIF
CALL iom_put( "woce", wn_crs ) ! vertical velocity
! free memory
! avs
SELECT CASE ( nn_crs_kz )
CASE ( 0 )
CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
CASE ( 1 )
CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
CASE ( 2 )
CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp )
END SELECT
!
CALL iom_put( "avt", avt_crs ) ! Kz on T
CALL iom_put( "avs", avs_crs ) ! Kz on S
! sbc fields
CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'T', tmask, utau_crs , p_e12=e2t , p_surf_crs=e2t_crs , psgn=1.0_wp ) !clem tau: check psgn ??
CALL crs_dom_ope( vtau , 'SUM', 'T', tmask, vtau_crs , p_e12=e1t , p_surf_crs=e1t_crs , psgn=1.0_wp ) !
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp )
CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL iom_put( "ssh" , sshn_crs ) ! ssh output
CALL iom_put( "utau" , utau_crs ) ! i-tau output
CALL iom_put( "vtau" , vtau_crs ) ! j-tau output
CALL iom_put( "wspd" , wndm_crs ) ! wind speed output
CALL iom_put( "runoffs" , rnf_crs ) ! runoff output
CALL iom_put( "qsr" , qsr_crs ) ! qsr output
CALL iom_put( "empmr" , emp_crs ) ! water flux output
CALL iom_put( "saltflx" , sfx_crs ) ! salt flux output
CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output
!
CALL iom_swap( "nemo" ) ! return back on high-resolution grid
!
IF( ln_timing ) CALL timing_stop('crs_fld')
!
END SUBROUTINE crs_fld
!!======================================================================
END MODULE crsfld