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

Last change on this file since 10425 was 10425, checked in by smasson, 5 years ago

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

  • Property svn:keywords set to Id
File size: 11.6 KB
RevLine 
[4015]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   !!----------------------------------------------------------------------
[5836]13   USE crs
14   USE crsdom
15   USE crslbclnk
[4015]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
[5836]20   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients
[4015]21   USE zdfddm          ! vertical  physics: double diffusion
[5836]22   !
23   USE in_out_manager  ! I/O manager
24   USE iom             !
[4015]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 "vectopt_loop_substitute.h90"
35   !!----------------------------------------------------------------------
[9598]36   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5217]37   !! $Id$
[10068]38   !! Software governed by the CeCILL license (see ./LICENSE)
[4015]39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE crs_fld( kt )
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.
[6140]51      !!  See. sbcmod.F90
[4015]52      !!
53      !! ** Method  : 
54      !!----------------------------------------------------------------------
[5836]55      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
56      !
57      INTEGER  ::   ji, jj, jk        ! dummy loop indices
58      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
[9019]59      REAL(wp) ::   zztmp             !   -      -
[5836]60      !
[9019]61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d
63      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs 
[5836]64      !!----------------------------------------------------------------------
[4015]65      !
[9124]66      IF( ln_timing )   CALL timing_start('crs_fld')
[4015]67
68      ! Depth work arrrays
[6140]69      ze3t(:,:,:) = e3t_n(:,:,:)
70      ze3u(:,:,:) = e3u_n(:,:,:)
71      ze3v(:,:,:) = e3v_n(:,:,:)
72      ze3w(:,:,:) = e3w_n(:,:,:)
[4015]73
74      IF( kt == nit000  ) THEN
75         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now
76         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
77         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
78         wn_crs   (:,:,:  ) = 0._wp    ! w
[9019]79         avs_crs  (:,:,:  ) = 0._wp    ! avt
[4015]80         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
81         sshn_crs (:,:    ) = 0._wp    ! ssh
82         utau_crs (:,:    ) = 0._wp    ! taux
83         vtau_crs (:,:    ) = 0._wp    ! tauy
84         wndm_crs (:,:    ) = 0._wp    ! wind speed
85         qsr_crs  (:,:    ) = 0._wp    ! qsr
86         emp_crs  (:,:    ) = 0._wp    ! emp
87         emp_b_crs(:,:    ) = 0._wp    ! emp
88         rnf_crs  (:,:    ) = 0._wp    ! runoff
89         fr_i_crs (:,:    ) = 0._wp    ! ice cover
90      ENDIF
91
92      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
93
94      ! 2. Coarsen fields at each time step
95      ! --------------------------------------------------------
96
97      !  Temperature
98      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
[6140]99      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
[4015]100      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
101
102      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
103      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
104
105     
106      !  Salinity
107      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
[6140]108      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
[4015]109      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
110
111      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
112      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
113
114      !  U-velocity
[6140]115      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
[4015]116      !
117      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
118      DO jk = 1, jpkm1
119         DO jj = 2, jpjm1
120            DO ji = 2, jpim1   
121               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
122               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
123            END DO
124         END DO
125      END DO
[6140]126      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
127      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
[4015]128
129      CALL iom_put( "uoce"  , un_crs )   ! i-current
130      CALL iom_put( "uocet" , zt_crs )   ! uT
131      CALL iom_put( "uoces" , zs_crs )   ! uS
132
133      !  V-velocity
[6140]134      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
[4015]135      !                                                                                 
136      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
137      DO jk = 1, jpkm1
138         DO jj = 2, jpjm1
139            DO ji = 2, jpim1   
140               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
141               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
142            END DO
143         END DO
144      END DO
[6140]145      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
146      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
[4015]147 
148      CALL iom_put( "voce"  , vn_crs )   ! i-current
149      CALL iom_put( "vocet" , zt_crs )   ! vT
150      CALL iom_put( "voces" , zs_crs )   ! vS
151
[9019]152      IF( iom_use( "eken") ) THEN     !      kinetic energy
153         z3d(:,:,jk) = 0._wp 
154         DO jk = 1, jpkm1
155            DO jj = 2, jpjm1
156               DO ji = fs_2, fs_jpim1   ! vector opt.
157                  zztmp  = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
158                  z3d(ji,jj,jk) = 0.25_wp * zztmp * (                                    &
159                     &            un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   &
160                     &          + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   &
161                     &          + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   &
162                     &          + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   )
163               END DO
164            END DO
165         END DO
[10425]166         CALL lbc_lnk( 'crsfld', z3d, 'T', 1. )
[9019]167         !
168         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
169         CALL iom_put( "eken", zt_crs )
170      ENDIF
[9598]171      !  Horizontal divergence ( following OCE/DYN/divhor.F90 )
[4015]172      DO jk = 1, jpkm1
173         DO ji = 2, jpi_crsm1
174            DO jj = 2, jpj_crsm1
175               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
176                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
177                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
178                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
179                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
180                   !
181                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
182               ENDIF
[9019]183            END DO
184         END DO
185      END DO
[4064]186      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
[4015]187      !
188      CALL iom_put( "hdiv", hdivn_crs ) 
189
190
191      !  W-velocity
192      IF( ln_crs_wn ) THEN
[4064]193         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
[6140]194       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
[4015]195      ELSE
196        wn_crs(:,:,jpk) = 0._wp
197        DO jk = jpkm1, 1, -1
198           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
199        ENDDO
200      ENDIF
201      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
202      !  free memory
203
[9019]204      !  avs
[4015]205      SELECT CASE ( nn_crs_kz )
206         CASE ( 0 )
[6140]207            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[9019]208            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[4015]209         CASE ( 1 )
[6140]210            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[9019]211            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[4015]212         CASE ( 2 )
[6140]213            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[9019]214            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
[4015]215      END SELECT
216      !
[9019]217      CALL iom_put( "avt", avt_crs )   !  Kz on T
218      CALL iom_put( "avs", avs_crs )   !  Kz on S
[4015]219     
220      !  sbc fields 
[6140]221      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 ) 
[4064]222      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
223      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
224      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
225      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
226      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
227      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
228      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
229      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
230      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
[4015]231
232      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output
233      CALL iom_put( "utau"     , utau_crs )   ! i-tau output
234      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output
235      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output
236      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output
237      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output
238      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output
[4064]239      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output
[4015]240      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output
241
242      !
243      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
244      !
[9124]245      IF( ln_timing )   CALL timing_stop('crs_fld')
[4015]246      !
247   END SUBROUTINE crs_fld
248
249   !!======================================================================
250END MODULE crsfld
Note: See TracBrowser for help on using the repository browser.