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 trunk/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 @ 7646

Last change on this file since 7646 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 11.0 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   USE wrk_nemo        ! working array
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   crs_fld                 ! routines called by step.F90
33
34   !! * Substitutions
35#  include "vectopt_loop_substitute.h90"
36   !!----------------------------------------------------------------------
37   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE crs_fld( kt )
44      !!---------------------------------------------------------------------
45      !!                  ***  ROUTINE crs_fld  ***
46      !!                   
47      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields
48      !!      NETCDF format is used by default
49      !!      1. Accumulate in time the dimensionally-weighted fields
50      !!      2. At time of output, rescale [1] by dimension and time
51      !!         to yield the spatial and temporal average.
52      !!  See. sbcmod.F90
53      !!
54      !! ** Method  : 
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
57      !
58      INTEGER  ::   ji, jj, jk        ! dummy loop indices
59      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
60      !
61      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
62      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
63      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs 
64      !!----------------------------------------------------------------------
65      !
66      IF( nn_timing == 1 )   CALL timing_start('crs_fld')
67
68      !  Initialize arrays
69      CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w )
70      CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v )
71      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   )
72      !
73      CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
74
75      ! Depth work arrrays
76      ze3t(:,:,:) = e3t_n(:,:,:)
77      ze3u(:,:,:) = e3u_n(:,:,:)
78      ze3v(:,:,:) = e3v_n(:,:,:)
79      ze3w(:,:,:) = e3w_n(:,:,:)
80
81      IF( kt == nit000  ) THEN
82         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now
83         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
84         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
85         wn_crs   (:,:,:  ) = 0._wp    ! w
86         avt_crs  (:,:,:  ) = 0._wp    ! avt
87         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
88         rke_crs  (:,:,:  ) = 0._wp    ! rke
89         sshn_crs (:,:    ) = 0._wp    ! ssh
90         utau_crs (:,:    ) = 0._wp    ! taux
91         vtau_crs (:,:    ) = 0._wp    ! tauy
92         wndm_crs (:,:    ) = 0._wp    ! wind speed
93         qsr_crs  (:,:    ) = 0._wp    ! qsr
94         emp_crs  (:,:    ) = 0._wp    ! emp
95         emp_b_crs(:,:    ) = 0._wp    ! emp
96         rnf_crs  (:,:    ) = 0._wp    ! runoff
97         fr_i_crs (:,:    ) = 0._wp    ! ice cover
98      ENDIF
99
100      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
101
102      ! 2. Coarsen fields at each time step
103      ! --------------------------------------------------------
104
105      !  Temperature
106      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
107      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
108      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
109
110      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
111      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
112
113     
114      !  Salinity
115      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
116      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
117      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
118
119      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
120      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
121
122      !  U-velocity
123      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
124      !
125      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
126      DO jk = 1, jpkm1
127         DO jj = 2, jpjm1
128            DO ji = 2, jpim1   
129               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
130               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
131            END DO
132         END DO
133      END DO
134      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
135      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
136
137      CALL iom_put( "uoce"  , un_crs )   ! i-current
138      CALL iom_put( "uocet" , zt_crs )   ! uT
139      CALL iom_put( "uoces" , zs_crs )   ! uS
140
141      !  V-velocity
142      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
143      !                                                                                 
144      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
145      DO jk = 1, jpkm1
146         DO jj = 2, jpjm1
147            DO ji = 2, jpim1   
148               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
149               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
150            END DO
151         END DO
152      END DO
153      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
154      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
155 
156      CALL iom_put( "voce"  , vn_crs )   ! i-current
157      CALL iom_put( "vocet" , zt_crs )   ! vT
158      CALL iom_put( "voces" , zs_crs )   ! vS
159
160     
161      !  Kinetic energy
162      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
163      CALL iom_put( "eken", rke_crs )
164
165      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 )
166      DO jk = 1, jpkm1
167         DO ji = 2, jpi_crsm1
168            DO jj = 2, jpj_crsm1
169               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
170                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
171                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
172                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
173                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
174                   !
175                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
176               ENDIF
177            ENDDO
178         ENDDO
179      ENDDO
180      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
181      !
182      CALL iom_put( "hdiv", hdivn_crs ) 
183
184
185      !  W-velocity
186      IF( ln_crs_wn ) THEN
187         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
188       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
189      ELSE
190        wn_crs(:,:,jpk) = 0._wp
191        DO jk = jpkm1, 1, -1
192           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
193        ENDDO
194      ENDIF
195      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
196      !  free memory
197
198      !  avt, avs
199!!gm BUG   TOP always uses avs !!!
200      SELECT CASE ( nn_crs_kz )
201         CASE ( 0 )
202            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
203         CASE ( 1 )
204            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
205         CASE ( 2 )
206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
207      END SELECT
208      !
209      CALL iom_put( "avt", avt_crs )   !  Kz
210     
211      !  sbc fields 
212      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 ) 
213      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
214      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
215      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
216      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
217      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
218      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
219      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
220      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
221      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
222
223      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output
224      CALL iom_put( "utau"     , utau_crs )   ! i-tau output
225      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output
226      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output
227      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output
228      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output
229      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output
230      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output
231      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output
232
233      !  free memory
234      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w )
235      CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v )
236      CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   )
237      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
238      !
239      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
240      !
241      IF( nn_timing == 1 )   CALL timing_stop('crs_fld')
242      !
243   END SUBROUTINE crs_fld
244
245   !!======================================================================
246END MODULE crsfld
Note: See TracBrowser for help on using the repository browser.