Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
MODULE usrdef_hgr
!!======================================================================
!! *** MODULE usrdef_hgr ***
!!
!! === VORTEX configuration ===
!!
!! User defined : mesh and Coriolis parameter of a user configuration
!!======================================================================
!! History : NEMO ! 2017-11 (J. Chanut) Original code
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! usr_def_hgr : initialize the horizontal mesh for VORTEX configuration
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
USE usrdef_nam, ONLY: rn_dx, rn_dy, rn_ppgphi0 ! horizontal resolution in meters
! and reference latitude
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
IMPLICIT NONE
PRIVATE
REAL(wp) :: roffsetx, roffsety ! Offset in km to first f-point
PUBLIC usr_def_hgr ! called by domhgr.F90
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: usrdef_hgr.F90 15119 2021-07-13 14:43:22Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE usr_def_hgr( plamt , plamu , plamv , plamf , & ! geographic position (required)
& pphit , pphiu , pphiv , pphif , & !
& kff , pff_f , pff_t , & ! Coriolis parameter (if domain not on the sphere)
& pe1t , pe1u , pe1v , pe1f , & ! scale factors (required)
& pe2t , pe2u , pe2v , pe2f , & !
& ke1e2u_v , pe1e2u , pe1e2v ) ! u- & v-surfaces (if gridsize reduction is used in strait(s))
!!----------------------------------------------------------------------
!! *** ROUTINE usr_def_hgr ***
!!
!! ** Purpose : user defined mesh and Coriolis parameter
!!
!! ** Method : set all intent(out) argument to a proper value
!! VORTEX configuration : beta-plance with uniform grid spacing (rn_dx)
!!
!! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees)
!! - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
!! - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
!! - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), INTENT(out) :: plamt, plamu, plamv, plamf ! longitude outputs [degrees]
REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphiu, pphiv, pphif ! latitude outputs [degrees]
INTEGER , INTENT(out) :: kff ! =1 Coriolis parameter computed here, =0 otherwise
REAL(wp), DIMENSION(:,:), INTENT(out) :: pff_f, pff_t ! Coriolis factor at f-point [1/s]
REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1v, pe1f ! i-scale factors [m]
REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2u, pe2v, pe2f ! j-scale factors [m]
INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces computed here, =0 otherwise
REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2]
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zbeta, zf0
REAL(wp) :: zti, ztj ! local scalars
!!-------------------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'usr_def_hgr : VORTEX configuration bassin'
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' Beta-plane with regular grid-spacing'
IF(lwp) WRITE(numout,*) ' given by rn_dx and rn_dy'
!
!
! Position coordinates (in kilometers)
! ==========
! offset is given at first f-point, i.e. at (i,j) = (nn_hls+1, nn_hls+1)
! Here we assume the grid is centred around a T-point at the middle of
! of the domain (hence domain size is odd)
roffsetx = (-REAL(Ni0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dx
roffsety = (-REAL(Nj0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dy
#if defined key_agrif
IF( .NOT.Agrif_Root() ) THEN
! deduce offset from parent:
roffsetx = Agrif_Parent(roffsetx) &
& + (-(nbghostcells_x_w - 1) + (Agrif_Parent(nbghostcells_x_w) + Agrif_Ix()-2)*Agrif_Rhox()) * 1.e-3 * rn_dx
roffsety = Agrif_Parent(roffsety) &
& + (-(nbghostcells_y_s - 1) + (Agrif_Parent(nbghostcells_y_s) + Agrif_Iy()-2)*Agrif_Rhoy()) * 1.e-3 * rn_dy
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
pphit(ji,jj) = roffsety + rn_dy * 1.e-3 * ( ztj - 0.5_wp )
pphiv(ji,jj) = roffsety + rn_dy * 1.e-3 * ztj
pphiu(ji,jj) = pphit(ji,jj)
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
! Horizontal scale factors (in meters)
! ======
pe1t(:,:) = rn_dx ; pe2t(:,:) = rn_dy
pe1u(:,:) = rn_dx ; pe2u(:,:) = rn_dy
pe1v(:,:) = rn_dx ; pe2v(:,:) = rn_dy
pe1f(:,:) = rn_dx ; pe2f(:,:) = rn_dy
! ! NO reduction of grid size in some straits
ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_hgr routine
pe1e2u(:,:) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that
pe1e2v(:,:) = 0._wp ! require an initialization of INTENT(out) arguments
!
!
! !== Coriolis parameter ==!
kff = 1 ! indicate not to compute Coriolis parameter afterward
!
zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra
zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 )
pff_f(:,:) = zf0 + zbeta * pphif(:,:) * 1.e+3
pff_t(:,:) = zf0 + zbeta * pphit(:,:) * 1.e+3
!
END SUBROUTINE usr_def_hgr
!!======================================================================
END MODULE usrdef_hgr