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 NEMO/trunk/src/OCE/CRS – NEMO

source: NEMO/trunk/src/OCE/CRS/crsfld.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 11.4 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 crs
14   USE crsdom
15   USE crslbclnk
16   USE oce             ! ocean dynamics and tracers
17   USE dom_oce         ! ocean space and time domain
18   USE sbc_oce         ! Surface boundary condition: ocean fields
19   USE zdf_oce         ! vertical  physics: ocean fields
20   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients
21   USE zdfddm          ! vertical  physics: double diffusion
22   !
23   USE in_out_manager  ! I/O manager
24   USE iom             !
25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
26   USE timing          ! preformance summary
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   crs_fld                 ! routines called by step.F90
32
33   !! * Substitutions
34#  include "do_loop_substitute.h90"
35   !!----------------------------------------------------------------------
36   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
37   !! $Id$
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE crs_fld( kt, Kmm )
43      !!---------------------------------------------------------------------
44      !!                  ***  ROUTINE crs_fld  ***
45      !!                   
46      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields
47      !!      NETCDF format is used by default
48      !!      1. Accumulate in time the dimensionally-weighted fields
49      !!      2. At time of output, rescale [1] by dimension and time
50      !!         to yield the spatial and temporal average.
51      !!  See. sbcmod.F90
52      !!
53      !! ** Method  : 
54      !!----------------------------------------------------------------------
55      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
56      INTEGER, INTENT(in) ::   Kmm  ! time level index
57      !
58      INTEGER  ::   ji, jj, jk        ! dummy loop indices
59      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
60      REAL(wp) ::   zztmp             !   -      -
61      !
62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d
64      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs 
65      !!----------------------------------------------------------------------
66      !
67      IF( ln_timing )   CALL timing_start('crs_fld')
68
69      ! Depth work arrrays
70      ze3t(:,:,:) = e3t(:,:,:,Kmm)
71      ze3u(:,:,:) = e3u(:,:,:,Kmm)
72      ze3v(:,:,:) = e3v(:,:,:,Kmm)
73      ze3w(:,:,:) = e3w(:,:,:,Kmm)
74
75      IF( kt == nit000  ) THEN
76         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now
77         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
78         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
79         wn_crs   (:,:,:  ) = 0._wp    ! w
80         avs_crs  (:,:,:  ) = 0._wp    ! avt
81         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
82         sshn_crs (:,:    ) = 0._wp    ! ssh
83         utau_crs (:,:    ) = 0._wp    ! taux
84         vtau_crs (:,:    ) = 0._wp    ! tauy
85         wndm_crs (:,:    ) = 0._wp    ! wind speed
86         qsr_crs  (:,:    ) = 0._wp    ! qsr
87         emp_crs  (:,:    ) = 0._wp    ! emp
88         emp_b_crs(:,:    ) = 0._wp    ! emp
89         rnf_crs  (:,:    ) = 0._wp    ! runoff
90         fr_i_crs (:,:    ) = 0._wp    ! ice cover
91      ENDIF
92
93      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
94
95      ! 2. Coarsen fields at each time step
96      ! --------------------------------------------------------
97
98      !  Temperature
99      zt(:,:,:) = ts(:,:,:,jp_tem,Kmm)  ;      zt_crs(:,:,:) = 0._wp
100      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
101      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
102
103      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
104      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
105
106     
107      !  Salinity
108      zs(:,:,:) = ts(:,:,:,jp_sal,Kmm)  ;      zs_crs(:,:,:) = 0._wp
109      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
110      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
111
112      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
113      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
114
115      !  U-velocity
116      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 )
117      !
118      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
119      DO_3D_00_00( 1, jpkm1 )
120         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) ) 
121         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) ) 
122      END_3D
123      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
124      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
125
126      CALL iom_put( "uoce"  , un_crs )   ! i-current
127      CALL iom_put( "uocet" , zt_crs )   ! uT
128      CALL iom_put( "uoces" , zs_crs )   ! uS
129
130      !  V-velocity
131      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 )
132      !                                                                                 
133      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
134      DO_3D_00_00( 1, jpkm1 )
135         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) ) 
136         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) ) 
137      END_3D
138      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
139      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
140 
141      CALL iom_put( "voce"  , vn_crs )   ! i-current
142      CALL iom_put( "vocet" , zt_crs )   ! vT
143      CALL iom_put( "voces" , zs_crs )   ! vS
144
145      IF( iom_use( "eken") ) THEN     !      kinetic energy
146         z3d(:,:,jk) = 0._wp 
147         DO_3D_00_00( 1, jpkm1 )
148            zztmp  = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
149            z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
150               &            uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
151               &          + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
152               &          + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
153               &          + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
154         END_3D
155         CALL lbc_lnk( 'crsfld', z3d, 'T', 1. )
156         !
157         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
158         CALL iom_put( "eken", zt_crs )
159      ENDIF
160      !  Horizontal divergence ( following OCE/DYN/divhor.F90 )
161      DO jk = 1, jpkm1
162         DO ji = 2, jpi_crsm1
163            DO jj = 2, jpj_crsm1
164               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
165                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
166                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
167                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
168                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
169                   !
170                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
171               ENDIF
172            END DO
173         END DO
174      END DO
175      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
176      !
177      CALL iom_put( "hdiv", hdivn_crs ) 
178
179
180      !  W-velocity
181      IF( ln_crs_wn ) THEN
182         CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
183       !  CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
184      ELSE
185        wn_crs(:,:,jpk) = 0._wp
186        DO jk = jpkm1, 1, -1
187           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
188        ENDDO
189      ENDIF
190      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
191      !  free memory
192
193      !  avs
194      SELECT CASE ( nn_crs_kz )
195         CASE ( 0 )
196            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
197            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
198         CASE ( 1 )
199            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
200            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
201         CASE ( 2 )
202            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
203            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
204      END SELECT
205      !
206      CALL iom_put( "avt", avt_crs )   !  Kz on T
207      CALL iom_put( "avs", avs_crs )   !  Kz on S
208     
209      !  sbc fields 
210      CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 ) 
211      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
212      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
213      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
214      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
215      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
216      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
217      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
218      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
219      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
220
221      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output
222      CALL iom_put( "utau"     , utau_crs )   ! i-tau output
223      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output
224      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output
225      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output
226      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output
227      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output
228      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output
229      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output
230
231      !
232      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
233      !
234      IF( ln_timing )   CALL timing_stop('crs_fld')
235      !
236   END SUBROUTINE crs_fld
237
238   !!======================================================================
239END MODULE crsfld
Note: See TracBrowser for help on using the repository browser.