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/nemo_v3_3_beta/NEMOGCM/NEMO/C1D_SRC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/C1D_SRC/dyncor_c1d.F90 @ 2382

Last change on this file since 2382 was 2382, checked in by gm, 13 years ago

v3.3beta: C1D - bug correction to compile with key_c1d

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