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 @ 5601

Last change on this file since 5601 was 5601, checked in by cbricaud, 9 years ago

commit changes/bugfix/... for crs ; ok with time-splitting/fixed volume

File size: 14.6 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 crslbclnk
27   USE iom
28   USE zdfmxl_crs
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   crs_fld                 ! routines called by step.F90
34
35
36   !! * Substitutions
37#  include "zdfddm_substitute.h90"
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
42   !! $Id $
43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE crs_fld( kt )
48      !!---------------------------------------------------------------------
49      !!                  ***  ROUTINE crs_fld  ***
50      !!                   
51      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields
52      !!      NETCDF format is used by default
53      !!      1. Accumulate in time the dimensionally-weighted fields
54      !!      2. At time of output, rescale [1] by dimension and time
55      !!         to yield the spatial and temporal average.
56      !!  See. diawri_dimg.h90, sbcmod.F90
57      !!
58      !! ** Method  : 
59      !!----------------------------------------------------------------------
60      !!
61     
62      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
63      !!
64      INTEGER               ::   ji, jj, jk              ! dummy loop indices
65      !!
66      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
67      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 
68      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs
69      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
70      REAL(wp)       :: z2dcrsu, z2dcrsv
71      REAL(wp)       :: zmin,zmax
72      INTEGER :: i,j,ijis,ijie,ijjs,ijje
73      REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z
74      INTEGER ::  iji,ijj
75      !!
76      !!----------------------------------------------------------------------
77
78      IF( nn_timing == 1 )   CALL timing_start('crs_fld')
79
80      !  Initialize arrays
81      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
82      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
83      CALL wrk_alloc( jpi, jpj, jpk, zt, zs         )
84      CALL wrk_alloc( jpi, jpj,      z2d            )
85      !
86      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
87      CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     )
88
89      ! Depth work arrrays
90      zfse3t(:,:,:) = fse3t(:,:,:)
91      zfse3u(:,:,:) = fse3u(:,:,:)
92      zfse3v(:,:,:) = fse3v(:,:,:)
93      zfse3w(:,:,:) = fse3w(:,:,:)
94
95      IF( kt == nit000  ) THEN
96         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now
97         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
98         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
99         wn_crs   (:,:,:  ) = 0._wp    ! w
100         avt_crs  (:,:,:  ) = 0._wp    ! avt
101         hdivb_crs(:,:,:  ) = 0._wp    ! hdiv
102         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
103         rke_crs  (:,:,:  ) = 0._wp    ! rke
104         sshn_crs (:,:    ) = 0._wp    ! ssh
105         utau_crs (:,:    ) = 0._wp    ! taux
106         vtau_crs (:,:    ) = 0._wp    ! tauy
107         wndm_crs (:,:    ) = 0._wp    ! wind speed
108         qsr_crs  (:,:    ) = 0._wp    ! qsr
109         emp_crs  (:,:    ) = 0._wp    ! emp
110         emp_b_crs(:,:    ) = 0._wp    ! emp
111         rnf_crs  (:,:    ) = 0._wp    ! runoff
112         fr_i_crs (:,:    ) = 0._wp    ! ice cover
113      ENDIF
114
115      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
116
117      ! 2. Coarsen fields at each time step
118      ! --------------------------------------------------------
119
120      !  Temperature
121      zt(:,:,:) = tsb(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
122      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
123      tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
124      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
125      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
126      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
127
128      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
129      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
130
131     
132      !  Salinity
133      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
134      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
135      tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
136      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
137      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
138      tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
139
140      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
141      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
142
143      !  U-velocity
144      CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
145      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
146      !cbr
147      ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:)
148      un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:)
149      !
150      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
151      DO jk = 1, jpkm1
152         DO jj = 2, jpjm1
153            DO ji = 2, jpim1   
154               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
155               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
156            END DO
157         END DO
158      END DO
159      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
160      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
161
162      CALL iom_put( "uoce"  , un_crs )   ! i-current
163      CALL iom_put( "uocet" , zt_crs )   ! uT
164      CALL iom_put( "uoces" , zs_crs )   ! uS
165
166      !  V-velocity
167      CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
168      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
169      vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:)
170      vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:)
171      !                                                                                 
172      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
173      DO jk = 1, jpkm1
174         DO jj = 2, jpjm1
175            DO ji = 2, jpim1   
176               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
177               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
178            END DO
179         END DO
180      END DO
181      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
182      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
183 
184      CALL iom_put( "voce"  , vn_crs )   ! i-current
185      CALL iom_put( "vocet" , zt_crs )   ! vT
186      CALL iom_put( "voces" , zs_crs )   ! vS
187
188     
189      !  Kinetic energy
190      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
191      CALL iom_put( "eken", rke_crs )
192
193      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 )
194      DO jk = 1, jpkm1
195         DO ji = 2, jpi_crsm1
196            DO jj = 2, jpj_crsm1
197               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
198                  !z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
199                  !   &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
200                  !z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
201                  !   &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
202                  !
203                  !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk)
204                  z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
205                     &     - ( un_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
206                  z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
207                     &     - ( vn_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
208                  !
209                  !cbr
210                  !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D )
211                  !bug2: mm test que bug1: on n'obtient tjs pas zero
212                  !on a la div calculée via ocean_volume_crs_t puis w via  e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk)
213                  !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810
214                  !                   e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6) 
215                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
216
217                  z2dcrsu =  ( ub_crs(ji  ,jj  ,jk) * e2e3u_msk(ji  ,jj  ,jk) ) &
218                     &     - ( ub_crs(ji-1,jj  ,jk) * e2e3u_msk(ji-1,jj  ,jk) )
219                  z2dcrsv =  ( vb_crs(ji  ,jj  ,jk) * e1e3v_msk(ji  ,jj  ,jk) ) &
220                     &     - ( vb_crs(ji  ,jj-1,jk) * e1e3v_msk(ji  ,jj-1,jk) )
221                  !
222                  IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) )
223               ENDIF
224            ENDDO
225         ENDDO
226      ENDDO
227      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
228      !
229      CALL iom_put( "hdiv", hdivn_crs ) 
230
231
232      !  W-velocity
233      IF( ln_crs_wn ) THEN
234         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
235      ELSE
236        wn_crs(:,:,jpk) = 0._wp
237        DO jk = jpkm1, 1, -1
238           wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
239           WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp )  wn_crs(:,:,jk) =  wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 
240        ENDDO
241      ENDIF
242
243      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
244      !  free memory
245
246      !  avt, avs
247      SELECT CASE ( nn_crs_kz )
248         CASE ( 0 )
249            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
250         CASE ( 1 )
251            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
252         CASE ( 2 )
253            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
254      END SELECT
255      !
256      CALL iom_put( "avt", avt_crs )   !  Kz
257     
258      !deja dasn step CALL zdf_mxl_crs(kt)
259
260 
261      !  sbc fields 
262
263      CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 ) 
264      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 ) 
265      CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 ) 
266      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
267      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
268      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
269      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
270      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
271      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
272      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
273      CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
274      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
275      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
276
277      z2d=REAL(nmln,wp)
278      CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
279      nmln_crs=INT(z2d_crs) 
280      nmln_crs=MAX(nlb10,nmln_crs)   
281
282      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output
283      CALL iom_put( "utau"     , utau_crs )   ! i-tau output
284      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output
285      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output
286      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output
287      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output
288      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output
289      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output
290      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output
291
292      !  free memory
293      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
294      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
295      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs         )
296      CALL wrk_dealloc( jpi, jpj, z2d                 )
297      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
298      CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs     )
299      !
300      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
301      !
302      IF( nn_timing == 1 )   CALL timing_stop('crs_fld')
303      !
304   END SUBROUTINE crs_fld
305
306   !!======================================================================
307END MODULE crsfld
Note: See TracBrowser for help on using the repository browser.