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

source: NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/STO/stopts.F90 @ 13463

Last change on this file since 13463 was 13463, checked in by andmirek, 4 years ago

Ticket #2195:update to trunk 13461
  • 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( 1, 1, 1, 1, 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.