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 NEMO/trunk/src/OCE/STO – NEMO

source: NEMO/trunk/src/OCE/STO/stopts.F90 @ 13286

Last change on this file since 13286 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 6.2 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   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   sto_pts         ! called by step.F90
22   PUBLIC   sto_pts_init    ! called by nemogcm.F90
23
24   ! Public array with random tracer fluctuations
25   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran
26
27   !! * Substitutions
28#  include "do_loop_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
31   !! $Id$
32   !! Software governed by the CeCILL license (see ./LICENSE)
33   !!----------------------------------------------------------------------
34CONTAINS
35
36   SUBROUTINE sto_pts( pts )
37      !!----------------------------------------------------------------------
38      !!                  ***  ROUTINE sto_pts  ***
39      !!
40      !! ** Purpose :   Compute current stochastic tracer fluctuations
41      !!
42      !! ** Method  :   Compute tracer differences from a random walk
43      !!                around every model grid point
44      !!
45      !!----------------------------------------------------------------------
46      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius]
47      !                                                               ! 2 : salinity               [psu]
48      INTEGER  ::   ji, jj, jk, jts, jdof ! dummy loop indices
49      INTEGER  ::   jim1, jjm1, jkm1  ! incremented indices
50      INTEGER  ::   jip1, jjp1, jkp1  !     -          -
51      REAL(wp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars
52      REAL(wp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        -
53      !!----------------------------------------------------------------------
54
55      DO jts = 1, jpts
56        CALL lbc_lnk( 'stopts', pts(:,:,:,jts), 'T' , 1._wp )
57      ENDDO
58
59      DO jdof = 1, nn_sto_eos
60        DO jts = 1, jpts
61           DO jk = 1, jpkm1
62              jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
63              DO jj = 1, jpj
64                 jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
65                 DO ji = 1, jpi
66                    jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
67                    !
68                    ! compute tracer gradient
69                    zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
70                    zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
71                    zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
72                    zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
73                    zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
74                    zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
75                    !
76                    ! compute random tracer fluctuation (zdts)
77                    zdts   = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
78                           & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
79                           & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
80!                   zdts   = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
81!                          & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
82!                          & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
83!                          & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
84!                          & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
85!                          & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
86                    zdts   = zdts  * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
87                    pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
88                    !
89                  END DO
90               END DO
91            END DO
92         END DO
93      END DO
94
95      ! Eliminate any possible negative salinity
96      DO jdof = 1, nn_sto_eos
97         DO_3D_11_11( 1, jpkm1 )
98            pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
99                                          &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
100                                          &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
101         END_3D
102      END DO
103
104      ! Eliminate any temperature lower than -2 degC
105!     DO jdof = 1, nn_sto_eos
106!        DO jk = 1, jpkm1
107!           DO jj = 1, jpj
108!              DO ji = 1, jpi
109!                 pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) ,    &
110!                                               &      MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
111!                                               &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
112!              END DO
113!           END DO
114!        END DO
115!     END DO
116
117
118      ! Lateral boundary conditions on pts_ran
119      DO jdof = 1, nn_sto_eos
120         DO jts = 1, jpts
121            CALL lbc_lnk( 'stopts', pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
122         END DO
123      END DO
124
125   END SUBROUTINE sto_pts
126
127
128   SUBROUTINE sto_pts_init
129      !!----------------------------------------------------------------------
130      !!                  ***  ROUTINE sto_pts_init  ***
131      !!
132      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
133      !!
134      !! ** Method  :   Allocate required array
135      !!
136      !!----------------------------------------------------------------------
137
138      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
139
140   END SUBROUTINE sto_pts_init
141
142END MODULE stopts
Note: See TracBrowser for help on using the repository browser.