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.
usrdef_sbc.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/USR – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/USR/usrdef_sbc.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 12.0 KB
Line 
1MODULE usrdef_sbc
2   !!======================================================================
3   !!                     ***  MODULE  usrdef_sbc  ***
4   !!
5   !!                     ===  GYRE 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   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case
14   !!----------------------------------------------------------------------
15   USE oce            ! ocean dynamics and tracers
16   USE dom_oce        ! ocean space and time domain
17   USE sbc_oce        ! Surface boundary condition: ocean fields
18   USE phycst         ! physical constants
19   !
20   USE in_out_manager ! I/O manager
21   USE lib_mpp        ! distribued memory computing library
22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
23   USE lib_fortran    !
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   usrdef_sbc_oce       ! routine called in sbcmod module
29   PUBLIC   usrdef_sbc_ice_tau   ! routine called by icestp.F90 for ice dynamics
30   PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo
31
32   !! * Substitutions
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
36   !! $Id$
37   !! Software governed by the CeCILL license (see ./LICENSE)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
42      !!---------------------------------------------------------------------
43      !!                    ***  ROUTINE usrdef_sbc  ***
44      !!             
45      !! ** Purpose :   provide at each time-step the GYRE surface boundary
46      !!              condition, i.e. the momentum, heat and freshwater fluxes.
47      !!
48      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
49      !!                CAUTION : never mask the surface stress field !
50      !!
51      !! ** Action  : - set the ocean surface boundary condition, i.e.   
52      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
53      !!
54      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000.
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt   ! ocean time step
57      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
58      !!
59      INTEGER  ::   ji, jj                 ! dummy loop indices
60      INTEGER  ::   zyear0                 ! initial year
61      INTEGER  ::   zmonth0                ! initial month
62      INTEGER  ::   zday0                  ! initial day
63      INTEGER  ::   zday_year0             ! initial day since january 1st
64      REAL(wp) ::   ztau     , ztau_sais   ! wind intensity and of the seasonal cycle
65      REAL(wp) ::   ztime                  ! time in hour
66      REAL(wp) ::   ztimemax , ztimemin    ! 21th June, and 21th decem. if date0 = 1st january
67      REAL(wp) ::   ztimemax1, ztimemin1   ! 21th June, and 21th decem. if date0 = 1st january
68      REAL(wp) ::   ztimemax2, ztimemin2   ! 21th June, and 21th decem. if date0 = 1st january
69      REAL(wp) ::   ztaun                  ! intensity
70      REAL(wp) ::   zemp_s, zemp_n, zemp_sais, ztstar
71      REAL(wp) ::   zcos_sais1, zcos_sais2, ztrp, zconv, t_star
72      REAL(wp) ::   zsumemp, zsurf
73      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
74      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
75      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
76      REAL(wp) ::   zyydd                 ! number of days in one year
77      !!---------------------------------------------------------------------
78      zyydd = REAL(nyear_len(1),wp)
79
80      ! ---------------------------- !
81      !  heat and freshwater fluxes  !
82      ! ---------------------------- !
83      !same temperature, E-P as in HAZELEGER 2000
84
85      zyear0     =   ndate0 / 10000                             ! initial year
86      zmonth0    = ( ndate0 - zyear0 * 10000 ) / 100            ! initial month
87      zday0      =   ndate0 - zyear0 * 10000 - zmonth0 * 100    ! initial day betwen 1 and 30
88      zday_year0 = ( zmonth0 - 1 ) * 30.+zday0                  ! initial day betwen 1 and 360
89
90      ! current day (in hours) since january the 1st of the current year
91      ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours)
92         &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours)
93
94      ztimemax1 = ((5.*30.)+21.)* 24.                      ! 21th june     at 24h in hours
95      ztimemin1 = ztimemax1 + rjjhh * zyydd / 2            ! 21th december        in hours
96      ztimemax2 = ((6.*30.)+21.)* 24.                      ! 21th july     at 24h in hours
97      ztimemin2 = ztimemax2 - rjjhh * zyydd / 2            ! 21th january         in hours
98      !                                                    ! NB: rjjhh * zyydd / 4 = one seasonal cycle in hours
99
100      ! amplitudes
101      zemp_S    = 0.7       ! intensity of COS in the South
102      zemp_N    = 0.8       ! intensity of COS in the North
103      zemp_sais = 0.1
104      zTstar    = 28.3      ! intemsity from 28.3 a -5 deg
105
106      ! 1/2 period between 21th June and 21th December and between 21th July and 21th January
107      zcos_sais1 = COS( (ztime - ztimemax1) / (ztimemin1 - ztimemax1) * rpi ) 
108      zcos_sais2 = COS( (ztime - ztimemax2) / (ztimemax2 - ztimemin2) * rpi )
109
110      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K)
111      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s
112      DO jj = 1, jpj
113         DO ji = 1, jpi
114            ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
115            ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
116            ! 64.5 in summer, 42.5 in winter
117            t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                &
118               &                    * COS( rpi * (gphit(ji,jj) - 5.)               &
119               &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) )
120            ! 23.5 deg : tropics
121            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) )
122            qns (ji,jj) = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - t_star ) - qsr(ji,jj)
123            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg
124               emp  (ji,jj) =   zemp_S * zconv   &
125                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  &
126                  &         * ( 1 - zemp_sais / zemp_S * zcos_sais1)
127            ELSE
128               emp (ji,jj) =  - zemp_N * zconv   &
129                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  &
130                  &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 )
131            ENDIF
132         END DO
133      END DO
134
135      zsumemp = GLOB_SUM( 'usrdef_sbc', emp  (:,:)   ) 
136      zsurf   = GLOB_SUM( 'usrdef_sbc', tmask(:,:,1) ) 
137      zsumemp = zsumemp / zsurf         ! Default GYRE configuration
138
139      ! freshwater (mass flux) and update of qns with heat content of emp
140      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average)
141      sfx (:,:) = 0.0_wp                                   ! no salt flux
142      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST
143
144
145      ! ---------------------------- !
146      !       momentum fluxes        !
147      ! ---------------------------- !
148      ! same wind as in Wico
149      !test date0 : ndate0 = 010203
150      zyear0  =   ndate0 / 10000
151      zmonth0 = ( ndate0 - zyear0 * 10000 ) / 100
152      zday0   =   ndate0 - zyear0 * 10000 - zmonth0 * 100
153      !Calculates nday_year, day since january 1st
154      zday_year0 = (zmonth0-1)*30.+zday0
155
156      !accumulates days of previous months of this year
157      ! day (in hours) since january the 1st
158      ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour
159         &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years
160      ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours
161      ztimemin = ztimemax + rjjhh * zyydd / 2      ! 21th december in hours
162      !                                            ! NB: rjjhh * zyydd / 4 = 1 seasonal cycle in hours
163
164      ! mean intensity at 0.105 ; srqt(2) because projected with 45deg angle
165      ztau = 0.105 / SQRT( 2. )
166      ! seasonal oscillation intensity
167      ztau_sais = 0.015
168      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi )
169      DO jj = 1, jpj
170         DO ji = 1, jpi
171           ! domain from 15deg to 50deg and 1/2 period along 14deg
172           ! so 5/4 of half period with seasonal cycle
173           utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) )
174           vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) )
175         END DO
176      END DO
177
178      ! module of wind stress and wind speed at T-point
179      zcoef = 1. / ( zrhoa * zcdrag ) 
180      DO jj = 2, jpjm1
181         DO ji = fs_2, fs_jpim1   ! vect. opt.
182            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
183            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
184            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
185            taum(ji,jj) = zmod
186            wndm(ji,jj) = SQRT( zmod * zcoef )
187         END DO
188      END DO
189      CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. )
190
191      ! ---------------------------------- !
192      !  control print at first time-step  !
193      ! ---------------------------------- !
194      IF( kt == nit000 .AND. lwp ) THEN
195         WRITE(numout,*)
196         WRITE(numout,*)'usrdef_sbc_oce : analytical surface fluxes for GYRE configuration'               
197         WRITE(numout,*)'~~~~~~~~~~~ ' 
198         WRITE(numout,*)'           nyear      = ', nyear
199         WRITE(numout,*)'           nmonth     = ', nmonth
200         WRITE(numout,*)'           nday       = ', nday
201         WRITE(numout,*)'           nday_year  = ', nday_year
202         WRITE(numout,*)'           ztime      = ', ztime
203         WRITE(numout,*)'           ztimemax   = ', ztimemax
204         WRITE(numout,*)'           ztimemin   = ', ztimemin
205         WRITE(numout,*)'           ztimemax1  = ', ztimemax1
206         WRITE(numout,*)'           ztimemin1  = ', ztimemin1
207         WRITE(numout,*)'           ztimemax2  = ', ztimemax2
208         WRITE(numout,*)'           ztimemin2  = ', ztimemin2
209         WRITE(numout,*)'           zyear0     = ', zyear0
210         WRITE(numout,*)'           zmonth0    = ', zmonth0
211         WRITE(numout,*)'           zday0      = ', zday0
212         WRITE(numout,*)'           zday_year0 = ', zday_year0
213         WRITE(numout,*)'           zyydd      = ', zyydd
214         WRITE(numout,*)'           zemp_S     = ', zemp_S
215         WRITE(numout,*)'           zemp_N     = ', zemp_N
216         WRITE(numout,*)'           zemp_sais  = ', zemp_sais
217         WRITE(numout,*)'           zTstar     = ', zTstar
218         WRITE(numout,*)'           zsumemp    = ', zsumemp
219         WRITE(numout,*)'           zsurf      = ', zsurf
220         WRITE(numout,*)'           ztrp       = ', ztrp
221         WRITE(numout,*)'           zconv      = ', zconv
222         WRITE(numout,*)'           ndastp     = ', ndastp
223         WRITE(numout,*)'           adatrj     = ', adatrj
224      ENDIF
225      !
226   END SUBROUTINE usrdef_sbc_oce
227
228
229   SUBROUTINE usrdef_sbc_ice_tau( kt )
230      INTEGER, INTENT(in) ::   kt   ! ocean time step
231   END SUBROUTINE usrdef_sbc_ice_tau
232
233
234   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
235      INTEGER, INTENT(in) ::   kt   ! ocean time step
236      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
237      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
238   END SUBROUTINE usrdef_sbc_ice_flx
239
240   !!======================================================================
241END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.