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.
dyncor_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/dyncor_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.2 KB
Line 
1MODULE dyncor_c1d
2   !!======================================================================
3   !!                     ***  MODULE  dyncor_c1d  ***
4   !! Ocean Dynamics :   Coriolis term in 1D configuration
5   !!=====================================================================
6   !! History :  2.0  !  2004-09  (C. Ethe)  Original code
7   !!            3.0  !  2008-04  (G. Madec)  style only
8   !!----------------------------------------------------------------------
9#if defined key_c1d
10   !!----------------------------------------------------------------------
11   !!   'key_c1d'                                          1D Configuration
12   !!----------------------------------------------------------------------
13   !!   cor_c1d      : Coriolis factor at T-point (1D configuration)
14   !!   dyn_cor_c1d  : vorticity trend due to Coriolis at T-point
15   !!----------------------------------------------------------------------
16   USE oce               ! ocean dynamics and tracers
17   USE dom_oce           ! ocean space and time domain
18   USE phycst            ! physical constants
19   USE in_out_manager    ! I/O manager
20   USE prtctl            ! Print control
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   cor_c1d      ! routine called by OPA.F90
26   PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90
27
28   !! * Array index permutations
29#  include "oce_ftrans.h90"
30#  include "dom_oce_ftrans.h90"
31
32   !! * Substitutions
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
36   !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $
37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE cor_c1d
42      !!----------------------------------------------------------------------
43      !!                   ***  ROUTINE cor_c1d  ***
44      !!
45      !! ** Purpose : set the Coriolis factor at T-point
46      !!----------------------------------------------------------------------
47      REAL(wp) ::   zphi0, zbeta, zf0         !  temporary scalars
48      !!----------------------------------------------------------------------
49
50      IF(lwp) WRITE(numout,*)
51      IF(lwp) WRITE(numout,*) 'cor_c1d : Coriolis factor at T-point'
52      IF(lwp) WRITE(numout,*) '~~~~~~~'
53
54      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
55      !
56      CASE ( 0, 1, 4 )               ! mesh on the sphere
57         ff(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) 
58         !
59      CASE ( 2 )                     ! f-plane at ppgphi0
60         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
61         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
62         !
63      CASE ( 3 )                     ! beta-plane
64         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
65         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points
66         zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
67         ff(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                      ! f = f0 +beta* y ( y=0 at south)
68         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
69         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
70         !
71      CASE ( 5 )                     ! beta-plane and rotated domain
72         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
73         zphi0 = 15.e0                                                      ! latitude of the first row F-points
74         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
75         ff(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
76         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
77         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
78         !
79      END SELECT
80      !
81   END SUBROUTINE cor_c1d
82
83
84   SUBROUTINE dyn_cor_c1d( kt )
85      !!----------------------------------------------------------------------
86      !!                   ***  ROUTINE dyn_cor_c1d  ***
87      !!
88      !! ** Purpose :   Compute the now Coriolis trend and add it to
89      !!               the general trend of the momentum equation in 1D case.
90      !!----------------------------------------------------------------------
91      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
92      !!
93      INTEGER ::   ji, jj, jk         ! dummy loop indices
94      !!----------------------------------------------------------------------
95      !
96      IF( kt == nit000 ) THEN
97         IF(lwp) WRITE(numout,*)
98         IF(lwp) WRITE(numout,*) 'dyn_cor_c1d : total vorticity trend in 1D'
99         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
100      ENDIF
101      !
102#if defined key_z_first
103      DO jj = 2, jpjm1
104         DO ji = 2, jpim1
105            DO jk = 1, jpkm1
106#else
107      DO jk = 1, jpkm1
108         DO jj = 2, jpjm1
109            DO ji = fs_2, fs_jpim1   ! vector opt.
110#endif
111               ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk)
112               va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk)
113            END DO
114         END DO
115      END DO   
116      !
117      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cor  - Ua: ', mask1=umask,  &
118         &                       tab3d_2=va, clinfo2=' Va: '       , mask2=vmask )
119      !
120   END SUBROUTINE dyn_cor_c1d
121
122#else
123   !!----------------------------------------------------------------------
124   !!   Default key                                     NO 1D Configuration
125   !!----------------------------------------------------------------------
126CONTAINS
127   SUBROUTINE cor_c1d              ! Empty routine
128   END SUBROUTINE cor_c1d   
129   SUBROUTINE dyn_cor_c1d ( kt )      ! Empty routine
130      WRITE(*,*) 'dyn_cor_c1d: You should not have seen this print! error?', kt
131   END SUBROUTINE dyn_cor_c1d
132#endif
133
134   !!=====================================================================
135END MODULE dyncor_c1d
Note: See TracBrowser for help on using the repository browser.