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_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/STO – NEMO

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90 @ 8485

Last change on this file since 8485 was 6486, checked in by davestorkey, 8 years ago

Remove SVN keywords from UKMO/dev_r5518_GO6_package branch.

File size: 6.3 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 "vectopt_loop_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
31   !! $Id$
32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
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( 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 jk = 1, jpkm1
98            DO jj = 1, jpj
99               DO ji = 1, jpi
100                  pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
101                                                &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
102                                                &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
103               END DO
104            END DO
105         END DO
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            CALL lbc_lnk( pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
126         END DO
127      END DO
128
129   END SUBROUTINE sto_pts
130
131
132   SUBROUTINE sto_pts_init
133      !!----------------------------------------------------------------------
134      !!                  ***  ROUTINE sto_pts_init  ***
135      !!
136      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
137      !!
138      !! ** Method  :   Allocate required array
139      !!
140      !!----------------------------------------------------------------------
141
142      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
143
144   END SUBROUTINE sto_pts_init
145
146END MODULE stopts
Note: See TracBrowser for help on using the repository browser.