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.
stopts.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/STO – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 7.1 KB
Line 
1MODULE stopts
2   !!==============================================================================
3   !!                       ***  MODULE  stopts  ***
4   !! Stochastic parameterization: compute stochastic tracer fluctuations
5   !!==============================================================================
6   !! History :  3.3  ! 2011-12 (J.-M. Brankart)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   sto_pts        : compute current stochastic tracer fluctuations
11   !!   sto_pts_init   : initialisation for stochastic tracer fluctuations
12   !!----------------------------------------------------------------------
13   USE dom_oce         ! ocean space and time domain
14   USE lbclnk          ! lateral boundary conditions (or mpp link)
15   USE phycst          ! physical constants
16   USE stopar          ! stochastic parameterization
17
18   USE yomhook, ONLY: lhook, dr_hook
19   USE parkind1, ONLY: jprb, jpim
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   sto_pts         ! called by step.F90
25   PUBLIC   sto_pts_init    ! called by nemogcm.F90
26
27   ! Public array with random tracer fluctuations
28   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran
29
30   !! * Substitutions
31#  include "vectopt_loop_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE sto_pts( pts )
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE sto_pts  ***
42      !!
43      !! ** Purpose :   Compute current stochastic tracer fluctuations
44      !!
45      !! ** Method  :   Compute tracer differences from a random walk
46      !!                around every model grid point
47      !!
48      !!----------------------------------------------------------------------
49      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius]
50      !                                                               ! 2 : salinity               [psu]
51      INTEGER  ::   ji, jj, jk, jts, jdof ! dummy loop indices
52      INTEGER  ::   jim1, jjm1, jkm1  ! incremented indices
53      INTEGER  ::   jip1, jjp1, jkp1  !     -          -
54      REAL(wp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars
55      REAL(wp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        -
56      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
57      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
58      REAL(KIND=jprb)               :: zhook_handle
59
60      CHARACTER(LEN=*), PARAMETER :: RoutineName='STO_PTS'
61
62      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
63
64      !!----------------------------------------------------------------------
65
66      DO jts = 1, jpts
67        CALL lbc_lnk( pts(:,:,:,jts), 'T' , 1._wp )
68      ENDDO
69
70      DO jdof = 1, nn_sto_eos
71        DO jts = 1, jpts
72           DO jk = 1, jpkm1
73              jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
74              DO jj = 1, jpj
75                 jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
76                 DO ji = 1, jpi
77                    jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
78                    !
79                    ! compute tracer gradient
80                    zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
81                    zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
82                    zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
83                    zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
84                    zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
85                    zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
86                    !
87                    ! compute random tracer fluctuation (zdts)
88                    zdts   = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
89                           & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
90                           & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
91!                   zdts   = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
92!                          & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
93!                          & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
94!                          & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
95!                          & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
96!                          & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
97                    zdts   = zdts  * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
98                    pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
99                    !
100                  END DO
101               END DO
102            END DO
103         END DO
104      END DO
105
106      ! Eliminate any possible negative salinity
107      DO jdof = 1, nn_sto_eos
108         DO jk = 1, jpkm1
109            DO jj = 1, jpj
110               DO ji = 1, jpi
111                  pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
112                                                &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
113                                                &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
114               END DO
115            END DO
116         END DO
117      END DO
118
119      ! Eliminate any temperature lower than -2 degC
120!     DO jdof = 1, nn_sto_eos
121!        DO jk = 1, jpkm1
122!           DO jj = 1, jpj
123!              DO ji = 1, jpi
124!                 pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) ,    &
125!                                               &      MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
126!                                               &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
127!              END DO
128!           END DO
129!        END DO
130!     END DO
131
132
133      ! Lateral boundary conditions on pts_ran
134      DO jdof = 1, nn_sto_eos
135         DO jts = 1, jpts
136            CALL lbc_lnk( pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
137         END DO
138      END DO
139
140      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
141   END SUBROUTINE sto_pts
142
143
144   SUBROUTINE sto_pts_init
145   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
146   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
147   REAL(KIND=jprb)               :: zhook_handle
148
149   CHARACTER(LEN=*), PARAMETER :: RoutineName='STO_PTS_INIT'
150
151   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
152
153      !!----------------------------------------------------------------------
154      !!                  ***  ROUTINE sto_pts_init  ***
155      !!
156      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
157      !!
158      !! ** Method  :   Allocate required array
159      !!
160      !!----------------------------------------------------------------------
161
162      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
163
164   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
165   END SUBROUTINE sto_pts_init
166
167END MODULE stopts
Note: See TracBrowser for help on using the repository browser.