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.
dynspg_flt.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 21.9 KB
Line 
1MODULE dynspg_flt
2   !!======================================================================
3   !!                   ***  MODULE  dynspg_flt  ***
4   !! Ocean dynamics:  surface pressure gradient trend
5   !!======================================================================
6   !! History    OPA  !  1998-05  (G. Roullet)  free surface
7   !!                 !  1998-10  (G. Madec, M. Imbard)  release 8.2
8   !!   NEMO     O.1  !  2002-08  (G. Madec)  F90: Free form and module
9   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
10   !!            1.0  !  2004-08  (C. Talandier) New trends organization
11   !!             -   !  2005-11  (V. Garnier) Surface pressure gradient organization
12   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
13   !!             -   !  2006-08  (J.Chanut, A.Sellar) Calls to BDY routines.
14   !!            3.2  !  2009-03  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
15   !!            3.7  !  2014-04  (F. Roquet, G. Madec)  add some trends diag
16   !!----------------------------------------------------------------------
17#if defined key_dynspg_flt   ||   defined key_esopa 
18   !!----------------------------------------------------------------------
19   !!   'key_dynspg_flt'                              filtered free surface
20   !!----------------------------------------------------------------------
21   !!   dyn_spg_flt  : update the momentum trend with the surface pressure gradient in the filtered free surface case
22   !!   flt_rst      : read/write the time-splitting restart fields in the ocean restart file
23   !!----------------------------------------------------------------------
24   USE oce             ! ocean dynamics and tracers
25   USE dom_oce         ! ocean space and time domain
26   USE zdf_oce         ! ocean vertical physics
27   USE sbc_oce         ! surface boundary condition: ocean
28   USE bdy_oce         ! Lateral open boundary condition
29   USE sol_oce         ! ocean elliptic solver
30   USE phycst          ! physical constants
31   USE domvvl          ! variable volume
32   USE dynadv          ! advection
33   USE solmat          ! matrix construction for elliptic solvers
34   USE solpcg          ! preconditionned conjugate gradient solver
35   USE solsor          ! Successive Over-relaxation solver
36   USE bdydyn          ! ocean open boundary condition on dynamics
37   USE bdyvol          ! ocean open boundary condition (bdy_vol routine)
38   USE cla             ! cross land advection
39   USE trd_oce         ! trends: ocean variables
40   USE trddyn          ! trend manager: dynamics
41   !
42   USE in_out_manager  ! I/O manager
43   USE lib_mpp         ! distributed memory computing library
44   USE wrk_nemo        ! Memory Allocation
45   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
46   USE prtctl          ! Print control
47   USE iom
48   USE lib_fortran
49   USE timing          ! Timing
50#if defined key_agrif
51   USE agrif_opa_interp
52#endif
53
54   USE yomhook, ONLY: lhook, dr_hook
55   USE parkind1, ONLY: jprb, jpim
56
57   IMPLICIT NONE
58   PRIVATE
59
60   PUBLIC   dyn_spg_flt  ! routine called by step.F90
61   PUBLIC   flt_rst      ! routine called by istate.F90
62
63   !! * Substitutions
64#  include "domzgr_substitute.h90"
65#  include "vectopt_loop_substitute.h90"
66   !!----------------------------------------------------------------------
67   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
68   !! $Id$
69   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
70   !!----------------------------------------------------------------------
71CONTAINS
72
73   SUBROUTINE dyn_spg_flt( kt, kindic )
74      !!----------------------------------------------------------------------
75      !!                  ***  routine dyn_spg_flt  ***
76      !!
77      !! ** Purpose :   Compute the now trend due to the surface pressure
78      !!      gradient in case of filtered free surface formulation  and add
79      !!      it to the general trend of momentum equation.
80      !!
81      !! ** Method  :   Filtered free surface formulation. The surface
82      !!      pressure gradient is given by:
83      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( sshn + btda )
84      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( sshn + btda )
85      !!      where sshn is the free surface elevation and btda is the after
86      !!      time derivative of the free surface elevation
87      !!       -1- evaluate the surface presure trend (including the addi-
88      !!      tional force) in three steps:
89      !!        a- compute the right hand side of the elliptic equation:
90      !!            gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
91      !!         where (spgu,spgv) are given by:
92      !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
93      !!                 - grav 2 rdt hu /e1u di[sshn + (emp-rnf)]
94      !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
95      !!                 - grav 2 rdt hv /e2v dj[sshn + (emp-rnf)]
96      !!         and define the first guess from previous computation :
97      !!            zbtd = btda
98      !!            btda = 2 zbtd - btdb
99      !!            btdb = zbtd
100      !!        b- compute the relative accuracy to be reached by the
101      !!         iterative solver
102      !!        c- apply the solver by a call to sol... routine
103      !!       -2- compute and add the free surface pressure gradient inclu-
104      !!      ding the additional force used to stabilize the equation.
105      !!
106      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
107      !!
108      !! References : Roullet and Madec, JGR, 2000.
109      !!---------------------------------------------------------------------
110      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
111      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge)
112      !
113      INTEGER  ::   ji, jj, jk   ! dummy loop indices
114      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars
115      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
116      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpw
117      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
118      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
119      REAL(KIND=jprb)               :: zhook_handle
120
121      CHARACTER(LEN=*), PARAMETER :: RoutineName='DYN_SPG_FLT'
122
123      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
124
125      !!----------------------------------------------------------------------
126      !
127      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_flt')
128      !
129      IF( kt == nit000 ) THEN
130         IF(lwp) WRITE(numout,*)
131         IF(lwp) WRITE(numout,*) 'dyn_spg_flt : surface pressure gradient trend'
132         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (free surface constant volume case)'
133       
134         ! set to zero free surface specific arrays
135         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction)
136         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction)
137
138         ! read filtered free surface arrays in restart file
139         ! when using agrif, sshn, gcx have to be read in istate
140         IF(.NOT. lk_agrif)   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields:
141         !                                                        ! gcx, gcxb
142      ENDIF
143
144      ! Local constant initialization
145      z2dt = 2. * rdt                                             ! time step: leap-frog
146      IF( neuler == 0 .AND. kt == nit000   )   z2dt = rdt         ! time step: Euler if restart from rest
147      IF( neuler == 0 .AND. kt == nit000+1 )   CALL sol_mat( kt )
148      z2dtg  = grav * z2dt
149
150      ! Evaluate the masked next velocity (effect of the additional force not included)
151      ! --------------------------------- 
152      IF( lk_vvl ) THEN          ! variable volume  (surface pressure gradient already included in dyn_hpg)
153         !
154         IF( ln_dynadv_vec ) THEN      ! vector form : applied on velocity
155            DO jk = 1, jpkm1
156               DO jj = 2, jpjm1
157                  DO ji = fs_2, fs_jpim1   ! vector opt.
158                     ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)  ) * umask(ji,jj,jk)
159                     va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * va(ji,jj,jk)  ) * vmask(ji,jj,jk)
160                  END DO
161               END DO
162            END DO
163            !
164         ELSE                          ! flux form : applied on thickness weighted velocity
165            DO jk = 1, jpkm1
166               DO jj = 2, jpjm1
167                  DO ji = fs_2, fs_jpim1   ! vector opt.
168                     ua(ji,jj,jk) = (        ub(ji,jj,jk) * fse3u_b(ji,jj,jk)      &
169                        &           + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk)  )   &
170                        &         / fse3u_a(ji,jj,jk) * umask(ji,jj,jk)
171                     va(ji,jj,jk) = (        vb(ji,jj,jk) * fse3v_b(ji,jj,jk)      &
172                        &           + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk)  )   &
173                        &         / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk)
174                 END DO
175               END DO
176            END DO
177            !
178         ENDIF
179        IF( l_trddyn )   THEN                      ! Put here so code doesn't crash when doing KE trend but needs to be done properly
180            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
181         ENDIF
182         !
183      ELSE                       ! fixed volume  (add the surface pressure gradient + unweighted time stepping)
184         !
185         DO jj = 2, jpjm1              ! Surface pressure gradient (now)
186            DO ji = fs_2, fs_jpim1   ! vector opt.
187               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
188               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
189            END DO
190         END DO
191         DO jk = 1, jpkm1              ! unweighted time stepping
192            DO jj = 2, jpjm1
193               DO ji = fs_2, fs_jpim1   ! vector opt.
194                  ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ( ua(ji,jj,jk) + spgu(ji,jj) )  ) * umask(ji,jj,jk)
195                  va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * ( va(ji,jj,jk) + spgv(ji,jj) )  ) * vmask(ji,jj,jk)
196               END DO
197            END DO
198         END DO
199         !
200         IF( l_trddyn )   THEN                      ! temporary save of spg trends
201            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
202            DO jk = 1, jpkm1              ! unweighted time stepping
203               DO jj = 2, jpjm1
204                  DO ji = fs_2, fs_jpim1   ! vector opt.
205                     ztrdu(ji,jj,jk) = spgu(ji,jj) * umask(ji,jj,jk)
206                     ztrdv(ji,jj,jk) = spgv(ji,jj) * vmask(ji,jj,jk)
207                  END DO
208               END DO
209            END DO
210            CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgexp, kt )
211         ENDIF
212         !
213      ENDIF
214
215#if defined key_bdy
216      IF( lk_bdy ) CALL bdy_dyn( kt )   ! Update velocities on each open boundary
217      IF( lk_bdy ) CALL bdy_vol( kt )   ! Correction of the barotropic component velocity to control the volume of the system
218#endif
219#if defined key_agrif
220      CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces
221#endif
222      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va))
223
224      ! compute the next vertically averaged velocity (effect of the additional force not included)
225      ! ---------------------------------------------
226      DO jj = 2, jpjm1
227         DO ji = fs_2, fs_jpim1   ! vector opt.
228            spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1)
229            spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1)
230         END DO
231      END DO
232      DO jk = 2, jpkm1                     ! vertical sum
233         DO jj = 2, jpjm1
234            DO ji = fs_2, fs_jpim1   ! vector opt.
235               spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk)
236               spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk)
237            END DO
238         END DO
239      END DO
240
241      DO jj = 2, jpjm1                     ! transport: multiplied by the horizontal scale factor
242         DO ji = fs_2, fs_jpim1   ! vector opt.
243            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
244            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
245         END DO
246      END DO
247      CALL lbc_lnk( spgu, 'U', -1. )       ! lateral boundary conditions
248      CALL lbc_lnk( spgv, 'V', -1. )
249
250      IF( lk_vvl ) CALL sol_mat( kt )      ! build the matrix at kt (vvl case only)
251
252      ! Right hand side of the elliptic equation and first guess
253      ! --------------------------------------------------------
254      DO jj = 2, jpjm1
255         DO ji = fs_2, fs_jpim1   ! vector opt.
256            ! Divergence of the after vertically averaged velocity
257            zgcb =  spgu(ji,jj) - spgu(ji-1,jj)   &
258                  + spgv(ji,jj) - spgv(ji,jj-1)
259            gcb(ji,jj) = gcdprc(ji,jj) * zgcb
260            ! First guess of the after barotropic transport divergence
261            zbtd = gcx(ji,jj)
262            gcx (ji,jj) = 2. * zbtd   - gcxb(ji,jj)
263            gcxb(ji,jj) =      zbtd
264         END DO
265      END DO
266      ! applied the lateral boundary conditions
267      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj )   
268
269#if defined key_agrif
270      IF( .NOT. AGRIF_ROOT() ) THEN
271         ! add contribution of gradient of after barotropic transport divergence
272         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =   &
273            &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:)
274         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =   &
275            &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:)
276         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =   &
277            &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     )
278         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =   &
279            &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2)
280      ENDIF
281#endif
282
283
284      ! Relative precision (computation on one processor)
285      ! ------------------
286      rnorme =0.e0
287      rnorme = GLOB_SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
288
289      epsr = eps * eps * rnorme
290      ncut = 0
291      ! if rnorme is 0, the solution is 0, the solver is not called
292      IF( rnorme == 0._wp ) THEN
293         gcx(:,:) = 0._wp
294         res   = 0._wp
295         niter = 0
296         ncut  = 999
297      ENDIF
298
299      ! Evaluate the next transport divergence
300      ! --------------------------------------
301      !    Iterarive solver for the elliptic equation (except IF sol.=0)
302      !    (output in gcx with boundary conditions applied)
303      kindic = 0
304      IF( ncut == 0 ) THEN
305         IF    ( nn_solv == 1 ) THEN   ;   CALL sol_pcg( kindic )      ! diagonal preconditioned conjuguate gradient
306         ELSEIF( nn_solv == 2 ) THEN   ;   CALL sol_sor( kindic )      ! successive-over-relaxation
307         ENDIF
308      ENDIF
309
310      ! Transport divergence gradient multiplied by z2dt
311      ! --------------------------------------------====
312      DO jj = 2, jpjm1
313         DO ji = fs_2, fs_jpim1   ! vector opt.
314            ! trend of Transport divergence gradient
315            ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj)
316            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
317            ! multiplied by z2dt
318#if defined key_bdy
319            IF(lk_bdy) THEN
320            ! caution : grad D = 0 along open boundaries
321               spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
322               spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
323            ELSE
324               spgu(ji,jj) = z2dt * ztdgu
325               spgv(ji,jj) = z2dt * ztdgv
326            ENDIF
327#else
328            spgu(ji,jj) = z2dt * ztdgu
329            spgv(ji,jj) = z2dt * ztdgv
330#endif
331         END DO
332      END DO
333
334#if defined key_agrif     
335      IF( .NOT. Agrif_Root() ) THEN
336         ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface
337         IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = z2dtg * z2dt * laplacu(2     ,:) * umask(2     ,:,1)
338         IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = z2dtg * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1)
339         IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = z2dtg * z2dt * laplacv(:,2     ) * vmask(:     ,2,1)
340         IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1)
341      ENDIF
342#endif     
343
344      IF( l_trddyn )   THEN                     
345         ztrdu(:,:,:) = ua(:,:,:)                 ! save the after velocity before the filtered SPG
346         ztrdv(:,:,:) = va(:,:,:)
347         !
348         CALL wrk_alloc( jpi, jpj, zpw )
349         !
350         zpw(:,:) = - z2dt * gcx(:,:)
351         CALL iom_put( "ssh_flt" , zpw )          ! output equivalent ssh modification due to implicit filter
352         !
353         !                                        ! save surface pressure flux: -pw at z=0
354         zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1)
355         CALL iom_put( "pw0_exp" , zpw )
356         zpw(:,:) = wn(:,:,1)
357         CALL iom_put( "w0" , zpw )
358         zpw(:,:) =  rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1)
359         CALL iom_put( "pw0_flt" , zpw )
360         !
361         CALL wrk_dealloc( jpi, jpj, zpw ) 
362         !                                   
363      ENDIF
364     
365      ! Add the trends multiplied by z2dt to the after velocity
366      ! -------------------------------------------------------
367      !     ( c a u t i o n : (ua,va) here are the after velocity not the
368      !                       trend, the leap-frog time stepping will not
369      !                       be done in dynnxt.F90 routine)
370      DO jk = 1, jpkm1
371         DO jj = 2, jpjm1
372            DO ji = fs_2, fs_jpim1   ! vector opt.
373               ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk)
374               va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk)
375            END DO
376         END DO
377      END DO
378
379      IF( l_trddyn )   THEN                      ! save the explicit SPG trends for further diagnostics
380         ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt
381         ztrdv(:,:,:) = ( va(:,:,:) - ztrdv(:,:,:) ) / z2dt
382         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt )
383         !
384         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
385      ENDIF
386
387      IF( lrst_oce )   CALL flt_rst( kt, 'WRITE' )      ! write filtered free surface arrays in restart file
388      !
389      IF( nn_timing == 1 )   CALL timing_stop('dyn_spg_flt')
390      !
391      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
392   END SUBROUTINE dyn_spg_flt
393
394
395   SUBROUTINE flt_rst( kt, cdrw )
396      !!---------------------------------------------------------------------
397      !!                   ***  ROUTINE ts_rst  ***
398      !!
399      !! ** Purpose : Read or write filtered free surface arrays in restart file
400      !!----------------------------------------------------------------------
401      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
402      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
403      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
404      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
405      REAL(KIND=jprb)               :: zhook_handle
406
407      CHARACTER(LEN=*), PARAMETER :: RoutineName='FLT_RST'
408
409      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
410
411      !!----------------------------------------------------------------------
412      !
413      IF( TRIM(cdrw) == 'READ' ) THEN
414         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
415! Caution : extra-hallow
416! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
417            IF(nn_timing == 2)  CALL timing_start('iom_rstget')
418            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
419            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
420            IF(nn_timing == 2)  CALL timing_stop('iom_rstget')
421            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:)
422         ELSE
423            gcx (:,:) = 0.e0
424            gcxb(:,:) = 0.e0
425         ENDIF
426      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
427! Caution : extra-hallow
428! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
429         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
430         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
431         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
432         IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
433      ENDIF
434      !
435      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
436   END SUBROUTINE flt_rst
437
438#else
439   !!----------------------------------------------------------------------
440   !!   Default case :   Empty module   No standart free surface cst volume
441   !!----------------------------------------------------------------------
442CONTAINS
443   SUBROUTINE dyn_spg_flt( kt, kindic )       ! Empty routine
444   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
445   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
446   REAL(KIND=jprb)               :: zhook_handle
447
448   CHARACTER(LEN=*), PARAMETER :: RoutineName='DYN_SPG_FLT'
449
450   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
451
452      WRITE(*,*) 'dyn_spg_flt: You should not have seen this print! error?', kt, kindic
453   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
454   END SUBROUTINE dyn_spg_flt
455   SUBROUTINE flt_rst    ( kt, cdrw )         ! Empty routine
456      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
457      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
458      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
459      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
460      REAL(KIND=jprb)               :: zhook_handle
461
462      CHARACTER(LEN=*), PARAMETER :: RoutineName='FLT_RST'
463
464      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
465
466      WRITE(*,*) 'flt_rst: You should not have seen this print! error?', kt, cdrw
467      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
468   END SUBROUTINE flt_rst
469#endif
470   
471   !!======================================================================
472END MODULE dynspg_flt
Note: See TracBrowser for help on using the repository browser.