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.
dynnxt_c1d.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90 @ 4460

Last change on this file since 4460 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

File size: 6.6 KB
Line 
1MODULE dynnxt_c1d
2   !!======================================================================
3   !!                       ***  MODULE  dynnxt_c1d  ***
4   !! Ocean dynamics: time stepping in 1D configuration
5   !!======================================================================
6   !! History :  2.0  !  2004-10  (C. Ethe)  Original code from dynnxt.F90
7   !!            3.0  !  2008-04  (G.madec)  Style only
8   !!----------------------------------------------------------------------
9#if defined key_c1d
10   !!----------------------------------------------------------------------
11   !!   'key_c1d'                                          1D Configuration
12   !!---------------------------------------------------------------------- 
13   !!   dyn_nxt_c1d : update the horizontal velocity from the momentum trend
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE in_out_manager  ! I/O manager
18   USE lbclnk          ! lateral boundary condition (or mpp link)
19   USE prtctl          ! Print control
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC dyn_nxt_c1d                ! routine called by step.F90
25   !! * Array index permutations
26#  include "oce_ftrans.h90"
27#  include "dom_oce_ftrans.h90"
28   !!----------------------------------------------------------------------
29   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
30   !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $
31   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE dyn_nxt_c1d ( kt )
36      !!----------------------------------------------------------------------
37      !!                  ***  ROUTINE dyn_nxt_c1d  ***
38      !!                   
39      !! ** Purpose :   Compute the after horizontal velocity from the momentum trend.
40      !!
41      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va)
42      !!      through calls to routine lbc_lnk.
43      !!      After velocity is compute using a leap-frog scheme environment:
44      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
45      !!      Time filter applied on now horizontal velocity to avoid the
46      !!      divergence of two consecutive time-steps and swap of dynamics
47      !!      arrays to start the next time step:
48      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
49      !!         (un,vn) = (ua,va)
50      !!
51      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
52      !!             - Update un,vn arrays, the now horizontal velocity
53      !!----------------------------------------------------------------------
54      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
55      !!
56#if defined key_z_first
57      INTEGER  ::   ji, jj, jk   ! dummy loop indices
58#else
59      INTEGER  ::   jk           ! dummy loop indices
60#endif
61      REAL(wp) ::   z2dt         ! temporary scalar
62      !!----------------------------------------------------------------------
63
64      IF( kt == nit000 ) THEN
65         IF(lwp) WRITE(numout,*)
66         IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation'
67         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
68      ENDIF
69
70      z2dt = 2._wp * rdt                                                   ! Local constant initialization
71      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
72
73      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
74
75#if defined key_z_first
76      DO jj = 1, jpj                                                       ! Next Velocity
77         DO ji = 1, jpi 
78            DO jk = 1, jpkm1
79               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
80               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
81            END DO
82         END DO
83      END DO 
84#else
85      DO jk = 1, jpkm1                                                     ! Next Velocity
86         ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
87         va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
88      END DO 
89#endif
90 
91#if defined key_z_first
92      IF( neuler == 0 .AND. kt == nit000 ) THEN                            ! Euler (forward) time stepping
93         DO jj = 1, jpj                                                    ! Time filter and swap of dynamics arrays
94            DO ji = 1, jpi
95               ub(ji,jj,1:jpkm1) = un(ji,jj,1:jpkm1)
96               vb(ji,jj,1:jpkm1) = vn(ji,jj,1:jpkm1)
97               un(ji,jj,1:jpkm1) = ua(ji,jj,1:jpkm1)
98               vn(ji,jj,1:jpkm1) = va(ji,jj,1:jpkm1)
99            END DO
100         END DO
101      ELSE                                                                ! Leap-frog time stepping
102         DO jj =1 , jpj
103            DO ji = 1, jpi
104               DO jk = 1, jpkm1
105                  ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk)
106                  vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk)
107                  un(ji,jj,jk) = ua(ji,jj,jk)
108                  vn(ji,jj,jk) = va(ji,jj,jk)
109               END DO
110            END DO
111         END DO
112      ENDIF
113#else
114      DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
115         IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
116             ub(:,:,jk) = un(:,:,jk)
117             vb(:,:,jk) = vn(:,:,jk)
118             un(:,:,jk) = ua(:,:,jk)
119             vn(:,:,jk) = va(:,:,jk)
120         ELSE                                                                    ! Leap-frog time stepping
121             ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk)
122             vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk)
123             un(:,:,jk) = ua(:,:,jk)
124             vn(:,:,jk) = va(:,:,jk)
125         ENDIF
126      END DO
127#endif
128
129      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
130         &                       tab3d_2=vn, clinfo2=' Vn: '           , mask2=vmask )
131      !
132   END SUBROUTINE dyn_nxt_c1d
133
134#else
135   !!----------------------------------------------------------------------
136   !!   Default key                                     NO 1D Config
137   !!----------------------------------------------------------------------
138CONTAINS
139   SUBROUTINE dyn_nxt_c1d ( kt )
140      WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt
141   END SUBROUTINE dyn_nxt_c1d
142#endif
143
144   !!======================================================================
145END MODULE dynnxt_c1d
Note: See TracBrowser for help on using the repository browser.