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/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/STO – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/STO/stopts.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496
  • Property svn:keywords set to Id
File size: 6.5 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#if defined key_mpi3
57        CALL lbc_lnk_nc_multi( 'stopts', pts(:,:,:,jts), 'T' , 1._wp )
58#else
59        CALL lbc_lnk( 'stopts', pts(:,:,:,jts), 'T' , 1._wp )
60#endif
61      ENDDO
62
63      DO jdof = 1, nn_sto_eos
64        DO jts = 1, jpts
65           DO jk = 1, jpkm1
66              jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
67              DO jj = 1, jpj
68                 jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
69                 DO ji = 1, jpi
70                    jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
71                    !
72                    ! compute tracer gradient
73                    zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
74                    zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
75                    zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
76                    zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
77                    zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
78                    zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
79                    !
80                    ! compute random tracer fluctuation (zdts)
81                    zdts   = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
82                           & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
83                           & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
84!                   zdts   = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
85!                          & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
86!                          & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
87!                          & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
88!                          & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
89!                          & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
90                    zdts   = zdts  * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
91                    pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
92                    !
93                  END DO
94               END DO
95            END DO
96         END DO
97      END DO
98
99      ! Eliminate any possible negative salinity
100      DO jdof = 1, nn_sto_eos
101         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
102            pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
103                                          &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
104                                          &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
105         END_3D
106      END DO
107
108      ! Eliminate any temperature lower than -2 degC
109!     DO jdof = 1, nn_sto_eos
110!        DO jk = 1, jpkm1
111!           DO jj = 1, jpj
112!              DO ji = 1, jpi
113!                 pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) ,    &
114!                                               &      MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
115!                                               &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
116!              END DO
117!           END DO
118!        END DO
119!     END DO
120
121
122      ! Lateral boundary conditions on pts_ran
123      DO jdof = 1, nn_sto_eos
124         DO jts = 1, jpts
125#if defined key_mpi3
126            CALL lbc_lnk_nc_multi( 'stopts', pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
127#else
128            CALL lbc_lnk( 'stopts', pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
129#endif
130         END DO
131      END DO
132
133   END SUBROUTINE sto_pts
134
135
136   SUBROUTINE sto_pts_init
137      !!----------------------------------------------------------------------
138      !!                  ***  ROUTINE sto_pts_init  ***
139      !!
140      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
141      !!
142      !! ** Method  :   Allocate required array
143      !!
144      !!----------------------------------------------------------------------
145
146      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
147
148   END SUBROUTINE sto_pts_init
149
150END MODULE stopts
Note: See TracBrowser for help on using the repository browser.