source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

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