source: NEMO/trunk/tests/SWG/MY_SRC/usrdef_sbc.F90 @ 15033

Last change on this file since 15033 was 15033, checked in by smasson, 6 months ago

trunk: suppress jpim1 et jpjm1, #2699

File size: 5.1 KB
Line 
1MODULE usrdef_sbc
2   !!======================================================================
3   !!                     ***  MODULE  usrdef_sbc  ***
4   !!
5   !!                     ===  SWG configuration  ===
6   !!
7   !! User defined :   surface forcing of a user configuration
8   !!======================================================================
9   !! History :  4.0  ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
10   !!             -   ! 2020-03  (A. Nasser) Shallow Water Eq. configuration
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case
15   !!----------------------------------------------------------------------
16   USE oce            ! ocean dynamics and tracers
17   USE dom_oce        ! ocean space and time domain
18   USE sbc_oce        ! Surface boundary condition: ocean fields
19   USE phycst         ! physical constants
20   USE usrdef_nam
21   !
22   USE in_out_manager ! I/O manager
23   USE lib_mpp        ! distribued memory computing library
24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
25   USE lib_fortran    ! Fortran library
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   usrdef_sbc_oce       ! routine called in sbcmod module
31   PUBLIC   usrdef_sbc_ice_tau   ! routine called by icestp.F90 for ice dynamics
32   PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo
33     
34   !! * Substitutions
35#  include "do_loop_substitute.h90"
36   !!----------------------------------------------------------------------
37   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
38   !! $Id: usrdef_sbc.F90 10425 2018-12-19 21:54:16Z smasson $
39   !! Software governed by the CeCILL license (see ./LICENSE)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
44      !!---------------------------------------------------------------------
45      !!                    ***  ROUTINE usrdef_sbc_oce  ***
46      !!             
47      !! ** Purpose :   provide at each time-step the GYRE surface boundary
48      !!              condition, i.e. the momentum, heat and freshwater fluxes.
49      !!
50      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
51      !!                CAUTION : never mask the surface stress field !
52      !!
53      !! ** Action  : - set the ocean surface boundary condition, i.e.   
54      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
55      !!
56      !!----------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt   ! ocean time step
58      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
59      !!
60      INTEGER  ::   ji, jj                ! dummy loop indices
61      REAL(wp) ::   ztauu, ztauv          ! wind intensity projeted
62      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
63      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
64      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
65      !!---------------------------------------------------------------------
66
67      ! ---------------------------- !
68      !  heat and freshwater fluxes  !   (no fluxes)
69      ! ---------------------------- !
70     
71      emp (:,:) = 0._wp
72      sfx (:,:) = 0._wp
73      qns (:,:) = 0._wp
74
75      ! ---------------------------- !
76      !       momentum fluxes        !
77      ! ---------------------------- !
78      ! rotated case (45deg)
79      ! ztauu = 0.2_wp / SQRT( 2._wp )    ! N.m-2
80      ! ztauv = 0.2_wp / SQRT( 2._wp)     ! N.m-2
81      ! non rotated
82      !ztauu = 0.2_wp                    ! N.m-2
83      !ztauv = 0._wp                     ! N.m-2
84      ! general case
85      ztauu =   REAL( rn_tau, wp ) * COS( rn_theta * rad )   ! N.m-2
86      ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad )   ! N.m-2
87     
88      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
89         ! length of the domain : 2000km x 2000km
90         utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp)
91         vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp)
92      END_2D
93     
94      ! module of wind stress and wind speed at T-point
95      zcoef = 1. / ( zrhoa * zcdrag ) 
96      DO_2D( 0, 0, 0, 0 )
97         ztx = utau(ji-1,jj  ) + utau(ji,jj) 
98         zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
99         zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
100         taum(ji,jj) = zmod
101         wndm(ji,jj) = SQRT( zmod * zcoef )
102      END_2D
103      CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. )
104      !
105   END SUBROUTINE usrdef_sbc_oce
106
107
108   SUBROUTINE usrdef_sbc_ice_tau( kt )
109      INTEGER, INTENT(in) ::   kt   ! ocean time step
110   END SUBROUTINE usrdef_sbc_ice_tau
111
112
113   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
114      INTEGER, INTENT(in) ::   kt   ! ocean time step
115      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
116      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
117   END SUBROUTINE usrdef_sbc_ice_flx
118
119   !!======================================================================
120END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.