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.
crsfld.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 @ 7215

Last change on this file since 7215 was 7215, checked in by cbricaud, 7 years ago

undo last commit in CRS ; back to rev7207
  • Property svn:keywords set to Id
File size: 22.7 KB
Line 
1MODULE crsfld
2   !!======================================================================
3   !!                     ***  MODULE  crsdfld  ***
4   !!  Ocean coarsening :  coarse ocean fields
5   !!=====================================================================
6   !!   2012-07  (J. Simeon, C. Calone, G. Madec, C. Ethe)
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   crs_fld       : create the standard output files for coarse grid and prep
11   !!                       other variables needed to be passed to TOP
12   !!----------------------------------------------------------------------
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE ldftra_oce      ! ocean active tracers: lateral physics
16   USE sbc_oce         ! Surface boundary condition: ocean fields
17   USE zdf_oce         ! vertical  physics: ocean fields
18   USE zdfddm          ! vertical  physics: double diffusion
19   USe zdfmxl
20   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
21   USE in_out_manager  ! I/O manager
22   USE timing          ! preformance summary
23   USE wrk_nemo        ! working array
24   USE crs
25   USE crsdom
26   USE domvvl
27   USE domvvl_crs
28   USE crslbclnk
29   USE iom
30   USE zdfmxl_crs
31   USE eosbn2
32   USE zdfevd_crs
33   USE zdftke
34   USE zdftke_crs
35
36   USE ieee_arithmetic
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   crs_fld                 ! routines called by step.F90
42
43
44   !! * Substitutions
45#  include "zdfddm_substitute.h90"
46#  include "domzgr_substitute.h90"
47#  include "vectopt_loop_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
50   !! $Id $
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE crs_fld( kt )
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE crs_fld  ***
58      !!                   
59      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields
60      !!      NETCDF format is used by default
61      !!      1. Accumulate in time the dimensionally-weighted fields
62      !!      2. At time of output, rescale [1] by dimension and time
63      !!         to yield the spatial and temporal average.
64      !!  See. diawri_dimg.h90, sbcmod.F90
65      !!
66      !! ** Method  : 
67      !!----------------------------------------------------------------------
68      !!
69     
70      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
71      !!
72      INTEGER               ::   ji, jj, jk              ! dummy loop indices
73      !!
74      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
75      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp
76      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs
77      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs
78      REAL(wp):: z2dcrsu, z2dcrsv
79      REAL(wp):: z1_2dt
80      REAL(wp):: zmin,zmax
81      INTEGER :: i,j,ijis,ijie,ijjs,ijje
82      INTEGER ::  iji,ijj
83      INTEGER :: jl,jm,jn
84      !!
85      !!----------------------------------------------------------------------
86
87      IF( nn_timing == 1 )   CALL timing_start('crs_fld')
88
89      !  Initialize arrays
90      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
91      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
92      CALL wrk_alloc( jpi, jpj, jpk, zt, zs , ztmp        )
93      CALL wrk_alloc( jpi, jpj,      z2d            )
94      !
95      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
96      CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     )
97
98      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
99
100      !---------------------------------------------------------------------------------------------------
101      !scale factors: swap
102      !---------------------------------------------------------------------------------------------------
103#if defined key_vvl
104      !e3t_b_crs(:,:,:) = e3t_n_crs(:,:,:)
105      !e3u_b_crs(:,:,:) = e3u_n_crs(:,:,:)
106      !e3v_b_crs(:,:,:) = e3v_n_crs(:,:,:)
107      !e3w_b_crs(:,:,:) = e3w_n_crs(:,:,:)
108      !e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:)
109      !e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:)
110      !e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:)
111      !e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:)
112 
113      !cbr: ds dynnxt, si  (lk_dynspg_ts.AND.ln_bt_fw) on fait un swap simple ( e3X_b_crs=e3X_n_crs )
114      !                 sinon e3X_b_crs passe par le filtre d'asselin !!!!!!
115      !     ds dommvl, swap simple pr  e3X_n_crs=e3X_a_crs
116
117
118      IF( kt /= nit000 )THEN
119      zfse3t(:,:,:) = e3t_b(:,:,:)
120      zfse3u(:,:,:) = e3u_b(:,:,:)
121      zfse3v(:,:,:) = e3v_b(:,:,:)
122      zfse3w(:,:,:) = e3w_b(:,:,:)
123      CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_b_crs, p_e3_max_crs=zs_crs)
124      CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_b_crs, p_e3_max_crs=zs_crs)
125      CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=e3u_b_crs, p_e3_max_crs=zs_crs)
126      CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=e3v_b_crs, p_e3_max_crs=zs_crs)
127      DO jk = 1, jpk
128         DO ji = 1, jpi_crs
129            DO jj = 1, jpj_crs
130               IF( e3t_b_crs(ji,jj,jk) == 0._wp ) e3t_b_crs(ji,jj,jk) = e3t_1d(jk)
131               IF( e3w_b_crs(ji,jj,jk) == 0._wp ) e3w_b_crs(ji,jj,jk) = e3w_1d(jk)
132               IF( e3u_b_crs(ji,jj,jk) == 0._wp ) e3u_b_crs(ji,jj,jk) = e3t_1d(jk)
133               IF( e3v_b_crs(ji,jj,jk) == 0._wp ) e3v_b_crs(ji,jj,jk) = e3t_1d(jk)
134            ENDDO
135        ENDDO
136      ENDDO
137
138      e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:)
139      e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:)
140      e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:)
141      e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:)
142
143      ENDIF
144#endif
145      !---------------------------------------------------------------------------------------------------
146      !variables domaine au temps before : swap
147      !---------------------------------------------------------------------------------------------------
148#if defined key_vvl
149      zfse3t(:,:,:) = e3t_b(:,:,:)
150      zfse3u(:,:,:) = e3u_b(:,:,:)
151      zfse3v(:,:,:) = e3v_b(:,:,:)
152      zfse3w(:,:,:) = e3w_b(:,:,:)
153#else
154      zfse3t(:,:,:) = e3t_0(:,:,:)
155      zfse3u(:,:,:) = e3u_0(:,:,:)
156      zfse3v(:,:,:) = e3v_0(:,:,:)
157      zfse3w(:,:,:) = e3w_0(:,:,:)
158#endif
159
160      !zmin=MINVAL();zmax=MAXVAL();CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ",zmin,zmax
161      !zmin=MINVAL();zmax=MAXVAL();CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ",zmin,zmax
162
163      IF( kt /= nit000 )THEN
164         emp_b_crs(:,:)        = emp_crs(:,:)
165         rnf_b_crs(:,:)        = rnf_crs(:,:)
166         hdivb_crs(:,:,:)      = hdivn_crs(:,:,:) !cbr hdivb_crs pas utile ?????????????????????????????????
167      ELSE
168         emp_b_crs(:,:    ) = 0._wp
169         rnf_b_crs(:,:    ) = 0._wp
170         hdivb_crs(:,:,:  ) = 0._wp  !cbr hdivb_crs pas utile ?????????????????????????????????
171      ENDIF
172
173      !  Temperature
174      zt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
175      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
176      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
177
178      !  Salinity
179      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
180      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
181      tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
182
183      !  U-velocity  !cb  pas utile ?????????????????????????????????
184      CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
185
186      !  V-velocity  pas utile ?????????????????????????????????
187      CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
188
189      ! n2
190      CALL crs_dom_ope( rn2b, 'VOL', 'W', tmask, rb2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
191
192      !ssh !cbr pas utile ??????????????????????????????????????
193      zfse3t(:,:,:) = 1._wp
194      CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )
195
196      !---------------------------------------------------------------------------------------------------
197      !variables domaine au temps now :
198      !---------------------------------------------------------------------------------------------------
199#if defined key_vvl
200      zfse3t(:,:,:) = e3t_n(:,:,:)
201      zfse3u(:,:,:) = e3u_n(:,:,:)
202      zfse3v(:,:,:) = e3v_n(:,:,:)
203      zfse3w(:,:,:) = e3w_n(:,:,:)
204      CALL iom_put("e3t",e3t_n_crs)
205      CALL iom_put("e3u",e3u_n_crs)
206      CALL iom_put("e3v",e3v_n_crs)
207      CALL iom_put("e3w",e3w_n_crs)
208#else
209      zfse3t(:,:,:) = e3t_0(:,:,:)
210      zfse3u(:,:,:) = e3u_0(:,:,:)
211      zfse3v(:,:,:) = e3v_0(:,:,:)
212      zfse3w(:,:,:) = e3w_0(:,:,:)
213#endif
214
215#if defined key_vvl
216      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
217      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
218      CALL iom_put("e2e3u_crs",e2e3u_crs)
219      CALL iom_put("e2e3u_msk",e2e3u_msk)
220      CALL iom_put("e1e3v_crs",e1e3v_crs)
221      CALL iom_put("e1e3v_msk",e1e3v_msk)
222      !                                                                                 
223      CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3t_max_n_crs)
224      CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3w_max_n_crs)
225      CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=zs_crs, p_e3_max_crs=e3u_max_n_crs)
226      CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_n_crs)
227
228     WHERE(e3t_max_n_crs == 0._wp) e3t_max_n_crs=r_inf
229     WHERE(e3u_max_n_crs == 0._wp) e3u_max_n_crs=r_inf
230     WHERE(e3v_max_n_crs == 0._wp) e3v_max_n_crs=r_inf
231     WHERE(e3w_max_n_crs == 0._wp) e3w_max_n_crs=r_inf
232
233      CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 )
234      CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
235
236      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
237      CALL iom_put("cvol_crs_t",ocean_volume_crs_t)
238      !
239      bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)*tmask_crs(:,:,:)
240      !
241      r1_bt_crs(:,:,:) = 0._wp
242      WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
243
244      CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
245
246#endif
247
248      !  Temperature
249      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
250      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
251      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
252
253      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
254      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
255
256      !  Salinity
257      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
258      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
259      tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
260
261      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
262      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
263
264      !  U-velocity
265      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
266      un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) !cbr utile ??????????????????
267      CALL iom_put( "uoce"  , un_crs )   ! i-current
268
269      !  V-velocity
270      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
271      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) !cbr utile ??????????????????
272      CALL iom_put( "voce"  , vn_crs )   ! i-current
273
274      !n2
275      CALL crs_dom_ope( rn2 , 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
276     
277      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 )
278      hdivn_crs(:,:,:)=0._wp
279      DO jk = 1, jpkm1
280         DO jj = 2,jpj_crs
281            DO ji = 2,jpi_crs
282               z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
283                 &      - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
284               z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
285                 &      - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
286
287               hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
288            ENDDO
289         ENDDO
290      ENDDO
291      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
292      !
293      CALL iom_put( "hdiv", hdivn_crs ) 
294
295
296      !  avt, avs
297      SELECT CASE ( nn_crs_kz )
298         CASE ( 0 )
299            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
300         CASE ( 1 )
301            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
302         CASE ( 2 )
303            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
304         CASE ( 3 )
305            CALL crs_dom_ope( avt, 'LOGVOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 )
306         CASE ( 4 )
307            CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
308         CASE ( 5 )
309#if defined key_zdftke
310            CALL crs_dom_ope( en        , 'VOL', 'W', tmask, en_crs   , p_e12=e1e2t, p_e3=zfse3w         , psgn=1.0 )
311            CALL crs_dom_ope( taum      , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
312            CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs  , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )
313            IF( kt==nit000 )CALL tke_avn_ini_crs
314            CALL tke_avn_crs
315            CALL zdf_evd_crs(kt)
316#endif
317
318      END SELECT
319      !
320      CALL iom_put( "avt", avt_crs )   !  Kz
321     
322      !2D fields
323      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
324      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
325      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
326      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
327      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
328#if defined key_vvl
329      CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
330#else
331      CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 )
332#endif
333      CALL crs_dom_ope( emp   ,'SUM', 'T', tmask, emp_crs   , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
334      CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
335      CALL crs_dom_ope( sfx   ,'SUM', 'T', tmask, sfx_crs   , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
336      CALL crs_dom_ope( fr_i  ,'SUM', 'T', tmask, fr_i_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
337
338      z2d=REAL(nmln,wp)
339      CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
340      nmln_crs=INT(z2d_crs) 
341      nmln_crs=MAX(nlb10,nmln_crs)   
342
343      CALL iom_put( "utau"     , utau_crs )   ! i-tau output
344      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output
345      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output
346      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output
347      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output
348      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output
349      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output
350      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output
351
352      zfse3t(:,:,:) = 1._wp
353      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 ) 
354      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output
355
356      zmin=MINVAL(emp);zmax=MAXVAL(emp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp",zmin,zmax 
357      zmin=MINVAL(emp_b);zmax=MAXVAL(emp_b);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_b",zmin,zmax 
358      zmin=MINVAL(emp_crs);zmax=MAXVAL(emp_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_crs",zmin,zmax 
359      zmin=MINVAL(emp_b_crs);zmax=MAXVAL(emp_b_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_b_crs",zmin,zmax 
360
361#if defined key_vvl
362      !---------------------------------------------------------------------------------------------------
363      !variables au temps after
364      !---------------------------------------------------------------------------------------------------
365
366      !cbr ssha_crs utile ??????????????????
367      zfse3t(:,:,:) = 1._wp
368      zt(:,:,:) = tmask(:,:,:)
369      ssha(:,:) = ssha(:,:) * tmask(:,:,1)  !cbr utile ??????????????????
370      CALL crs_dom_ope( ssha , 'VOL', 'T', zt, ssha_crs , p_e12=e1e2t,  p_e3=zfse3t , psgn=1.0 )
371      !CALL crs_lbc_lnk( ssha_crs, 'T', 1.0 ) !!!!!!!!!!!!!!!!!!! pas utile !!!!!!!!!!!!!!!!!!!!!!!!!
372
373
374      zfse3t(:,:,:) = e3t_a(:,:,:)
375      zfse3u(:,:,:) = e3u_a(:,:,:)
376      zfse3v(:,:,:) = e3v_a(:,:,:)
377      CALL dom_vvl_interpol( zfse3t(:,:,:), zfse3w(:,:,:), 'W'   )
378
379      CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_a_crs, p_e3_max_crs=zs_crs)
380      CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_a_crs, p_e3_max_crs=zs_crs)
381      CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs  , cd_type='U', p_mask=umask, p_e3_crs=e3u_a_crs, p_e3_max_crs=zs_crs)
382      CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs  , cd_type='V', p_mask=vmask, p_e3_crs=e3v_a_crs, p_e3_max_crs=zs_crs)
383
384
385      !DO ji=1,jpi_crs
386      !   DO jj=1,jpj_crs
387      !      fse3t_a_crs(ji,jj,jk),fse3t_b_crs(ji,jj,jk)+fse3t_n_crs(ji,jj,jk)*(ssha_crs(ji,jj)-sshb_crs(ji,jj))/(ht_0_crs(ji,jj)+sshn_crs(ji,jj))
388      !   ENDDO
389      !ENDDO
390      !CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3u_a(:,:,:), 'U' )
391      !CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3v_a(:,:,:), 'V' )
392      !CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3w_a(:,:,:), 'W' )
393
394      !CALL crs_dom_sfc( umask, 'U', zt_crs, zs_crs, p_e2=e2u, p_e3=zfse3u ) ! zt_crs=e2e3u_crs,zs_crs=e2e3u_msk ça sert à quoi ???????????????????????????????????????????
395      !CALL crs_dom_sfc( vmask, 'V', zt_crs, zs_crs, p_e1=e2v, p_e3=zfse3v ) ! zt_crs=e1e3v_crs,zs_crs=e1e3v_msk ça sert à quoi ???????????????????????????????????????????
396
397      DO jk = 1, jpk
398         DO ji = 1, jpi_crs
399            DO jj = 1, jpj_crs
400               IF( e3t_a_crs(ji,jj,jk) == 0._wp ) e3t_a_crs(ji,jj,jk) = e3t_1d(jk)
401               IF( e3w_a_crs(ji,jj,jk) == 0._wp ) e3w_a_crs(ji,jj,jk) = e3w_1d(jk)
402               IF( e3u_a_crs(ji,jj,jk) == 0._wp ) e3u_a_crs(ji,jj,jk) = e3t_1d(jk)
403               IF( e3v_a_crs(ji,jj,jk) == 0._wp ) e3v_a_crs(ji,jj,jk) = e3t_1d(jk)
404            ENDDO
405        ENDDO
406      ENDDO
407
408      zmin=MINVAL(e3t_b);zmax=MAXVAL(e3t_b);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_b",zmin,zmax 
409      zmin=MINVAL(e3t_n);zmax=MAXVAL(e3t_n);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_n",zmin,zmax 
410      zmin=MINVAL(e3t_a);zmax=MAXVAL(e3t_a);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_a",zmin,zmax 
411      zmin=MINVAL(e3t_b_crs);zmax=MAXVAL(e3t_b_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_b_crs",zmin,zmax 
412      zmin=MINVAL(e3t_n_crs);zmax=MAXVAL(e3t_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_n_crs",zmin,zmax 
413      zmin=MINVAL(e3t_a_crs);zmax=MAXVAL(e3t_a_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_a_crs",zmin,zmax 
414      zmin=MINVAL(sshb);zmax=MAXVAL(sshb);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshb",zmin,zmax 
415      zmin=MINVAL(sshn);zmax=MAXVAL(sshn);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshn",zmin,zmax 
416      zmin=MINVAL(ssha);zmax=MAXVAL(ssha);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ssha",zmin,zmax 
417      zmin=MINVAL(sshb_crs);zmax=MAXVAL(sshb_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshb_crs",zmin,zmax 
418      zmin=MINVAL(sshn_crs);zmax=MAXVAL(sshn_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshn_crs",zmin,zmax 
419      zmin=MINVAL(ssha_crs);zmax=MAXVAL(ssha_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ssha_crs",zmin,zmax 
420
421      !zt_crs=ocean_volume_crs_t ; zs_crs=facvol_t after time !!! ça sert à quoi ???????????????????????????????????????????
422      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, zt_crs, zs_crs )
423
424#endif
425
426#if defined key_vvl
427      z1_2dt = 1._wp / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog)
428      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
429      wn_crs(:,:,jpk) = 0._wp
430      DO jk = jpkm1, 1, -1
431         wn_crs(:,:,jk) = wn_crs(:,:,jk+1)*e1e2w_msk(:,:,jk+1) - (  hdivn_crs(:,:,jk)                                   &
432               &                          + z1_2dt * e1e2w_crs(:,:,jk) * ( e3t_a_crs(:,:,jk) - e3t_b_crs(:,:,jk) ) ) * tmask_crs(:,:,jk)
433         WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
434
435
436      ENDDO
437#else
438      IF( ln_crs_wn ) THEN
439         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
440      ELSE
441         wn_crs(:,:,jpk) = 0._wp
442         DO jk = jpkm1, 1, -1
443            wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
444            WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
445         ENDDO
446       ENDIF
447
448#endif
449      CALL crs_lbc_lnk( wn_crs, 'W', 1.0 )   !!!!!!!pas utile, nan ??????????????????????
450      wn_crs(:,:,:) = wn_crs(:,:,:) * tmask_crs(:,:,:)   !!!!!!!pas utile, nan ??????????????????????
451
452      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
453
454      !  free memory
455      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
456      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
457      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp   )
458      CALL wrk_dealloc( jpi, jpj, z2d                 )
459      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
460      CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs     )
461      !
462      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
463      !
464      IF( nn_timing == 1 )   CALL timing_stop('crs_fld')
465      !
466   END SUBROUTINE crs_fld
467
468   !!======================================================================
469END MODULE crsfld
Note: See TracBrowser for help on using the repository browser.