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.
gridrandom.F90 in NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC – NEMO

source: NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/gridrandom.F90 @ 13432

Last change on this file since 13432 was 4599, checked in by pabouttier, 10 years ago

Add W and F point treatments in grid_random.F90, see Ticket #1285
  • Property svn:executable set to *
File size: 10.2 KB
Line 
1MODULE gridrandom
2   !!======================================================================
3   !!                       *** MODULE gridrandom ***
4   !!
5   !! NEMOVAR: Construct gridded random noise fields
6   !!======================================================================
7   !!----------------------------------------------------------------------
8   !! grid_2d_ran     : Fill a 2D array with uncorrelated Gaussian noise
9   !!                   using a constant seed
10   !! grid_3d_ran     : Fill a 3D array with uncorrelated Gaussian noise
11   !!                   using a constant seed
12   !! grid_2d_ran_2d  : Fill a 2D array with uncorrelated Gaussian noise
13   !!                   using a 2D seed array (for MPP)
14   !! grid_3d_ran_2d  : Fill a 3D array with uncorrelated Gaussian noise
15   !!                   using a 2D seed array (for MPP)
16   !! grid_write_seed : Write out the 2D seed array for the random number
17   !!                   generator
18   !!----------------------------------------------------------------------
19   !! * Modules used
20   USE par_kind       ! Kind variables
21   USE dom_oce        ! Domain variables
22   USE in_out_manager ! I/O stuff
23   USE iom            ! I/O manager
24   USE ran_num        ! Random number routines
25   USE lbclnk         ! Boundary conditions and halos
26
27   IMPLICIT NONE
28
29   INTERFACE grid_random
30      MODULE PROCEDURE grid_2d_ran, grid_3d_ran
31   END INTERFACE
32
33   INTERFACE grid_rd_sd
34      MODULE PROCEDURE grid_2d_rd_sd_loc,  &
35         &             grid_3d_rd_sd_loc
36   END INTERFACE
37
38   !! * Routine accessibility
39   PRIVATE
40
41   PUBLIC &
42      & grid_random,      &
43      & grid_rd_sd
44
45CONTAINS
46
47   SUBROUTINE grid_2d_ran( pt2d, cd_type, pmean, pstd )
48      !!----------------------------------------------------------------------
49      !!               ***  ROUTINE grid_2d_ran ***
50      !!         
51      !! ** Purpose : Fill a 2D (surface) array with uncorrelated Gaussian
52      !!              noise.
53      !!
54      !! ** Method  : The value of kseed is the seed for the random number
55      !!              generator. On the first call to "grid_2d_ran" it should
56      !!              be set to a large negative number.
57      !!
58      !!              Apply the appropriate grid-point mask and lateral
59      !!              boundary conditions before exiting.
60      !!
61      !! ** Action  :
62      !!
63      !! References :
64      !!
65      !! History :
66      !!        !  07-11  (A. Weaver) 
67      !!----------------------------------------------------------------------
68      !! * Modules used
69
70      !! * Arguments
71      REAL, INTENT(INOUT), DIMENSION(jpi,jpj) :: &
72         & pt2d        ! 2D field
73      REAL(wp), INTENT(IN) :: &
74         & pmean, &    ! Mean of noise
75         & pstd        ! Standard deviation of noise
76
77      !! * Local declarations
78      CHARACTER(LEN=1), INTENT(IN) ::   &
79         & cd_type     ! Nature of pt2d grid-point
80                       !   = T , U  or V  grid-point
81      INTEGER :: &
82         & ji, &
83         & jj
84
85      !--------------------------------------------------------------------
86      ! Fill in the 2D field with Gaussian noise
87      !--------------------------------------------------------------------
88
89      DO jj = 1, jpj
90         DO ji = 1, jpi
91            pt2d(ji,jj) = gaustb( pstd, pmean )
92         END DO
93      END DO
94
95      !--------------------------------------------------------------------
96      ! Apply masks and lateral boundary conditions
97      !--------------------------------------------------------------------
98
99      SELECT CASE ( cd_type )
100      CASE( 'T' )
101 
102         pt2d(:,:) = pt2d(:,:) * tmask(:,:,1)
103         CALL lbc_lnk( pt2d, 'T',  1.0 )
104
105      CASE( 'U' ) 
106
107         pt2d(:,:) = pt2d(:,:) * umask(:,:,1)
108         CALL lbc_lnk( pt2d, 'U', -1.0 )
109
110      CASE ( 'V' )
111
112         pt2d(:,:) = pt2d(:,:) * vmask(:,:,1)
113         CALL lbc_lnk( pt2d, 'V', -1.0 )
114
115      CASE ( 'S' ) !: AV: S ???
116         CALL lbc_lnk( pt2d, 'S', 1.0 )
117
118      CASE ( 'F' )         
119     
120         pt2d(:,:) = pt2d(:,:) * fmask(:,:,1)
121         CALL lbc_lnk( pt2d, 'F',  1.0 )
122
123      CASE ( 'W' )         
124     
125         pt2d(:,:) = pt2d(:,:) * tmask(:,:,1)
126         CALL lbc_lnk( pt2d, 'W',  1.0 )
127
128      END SELECT
129           
130   END SUBROUTINE grid_2d_ran
131         
132   SUBROUTINE grid_3d_ran( pt3d, cd_type, pmean, pstd )
133      !!----------------------------------------------------------------------
134      !!               ***  ROUTINE grid_3d_ran ***
135      !!         
136      !! ** Purpose : Fill a 3D array with uncorrelated Gaussian noise.
137      !!
138      !! ** Method  : The value of kseed is the seed for the random number
139      !!              generator. On the first call to "grid_3d_ran" it should
140      !!              be set to a large negative number.
141      !!
142      !!              Apply the appropriate grid-point mask and lateral
143      !!              boundary conditions before exiting.
144      !!
145      !! ** Action  :
146      !!
147      !! References :
148      !!
149      !! History :
150      !!        !  07-11  (A. Weaver) 
151      !!----------------------------------------------------------------------
152      !! * Modules used
153
154      !! * Arguments
155      REAL, INTENT(INOUT), DIMENSION(jpi,jpj,jpk) :: &
156         & pt3d        ! 3D field
157      REAL(wp), INTENT(IN) :: &
158         & pmean, &    ! Mean of noise
159         & pstd        ! Standard deviation of noise
160 
161      !! * Local declarations
162      CHARACTER(LEN=1), INTENT(IN) ::   &
163         & cd_type     ! Nature of pt3d grid-point
164                       !   = T , U  or V  grid-point
165      INTEGER  :: &
166         & ji, &
167         & jj, &
168         & jk
169
170      !--------------------------------------------------------------------
171      ! Fill in the 3D field with Gaussian noise
172      !--------------------------------------------------------------------
173
174      DO jk = 1, jpk
175         DO jj = 1, jpj
176            DO ji = 1, jpi
177               pt3d(ji,jj,jk) = gaustb( pstd, pmean )
178            END DO
179         END DO
180      END DO
181
182      !--------------------------------------------------------------------
183      ! Apply masks and lateral boundary conditions
184      !--------------------------------------------------------------------
185
186      SELECT CASE ( cd_type )
187      CASE( 'T' )
188
189         pt3d(:,:,:) = pt3d(:,:,:) * tmask(:,:,:)
190         CALL lbc_lnk( pt3d, 'T',  1.0 )
191         
192      CASE( 'U' )
193           
194         pt3d(:,:,:) = pt3d(:,:,:) * umask(:,:,:)
195         CALL lbc_lnk( pt3d, 'U', -1.0 )
196           
197      CASE( 'V' )
198         
199         pt3d(:,:,:) = pt3d(:,:,:) * vmask(:,:,:)
200         CALL lbc_lnk( pt3d, 'V', -1.0 )
201
202      CASE( 'S' ) !: AV: S ???
203
204         CALL lbc_lnk( pt3d, 'S', 1.0 )
205
206      CASE( 'W' )
207
208         pt3d(:,:,:) = pt3d(:,:,:) * tmask(:,:,:)
209         CALL lbc_lnk( pt3d, 'W',  1.0 )
210
211      CASE( 'F' )
212
213         pt3d(:,:,:) = pt3d(:,:,:) * fmask(:,:,:)
214         CALL lbc_lnk( pt3d, 'F',  1.0 )
215
216      END SELECT
217
218   END SUBROUTINE grid_3d_ran
219     
220   SUBROUTINE grid_2d_rd_sd_loc( pt2d, cd_type, pmean, pstd )
221      !!----------------------------------------------------------------------
222      !!               ***  ROUTINE grid_2d_rd_sd ***
223      !!         
224      !! ** Purpose : Fill a 2D (surface) array with uncorrelated Gaussian
225      !!              noise.
226      !!
227      !! ** Method  : The value of kseed is an integer from which a seed is
228      !!              generated for the random number
229      !!              and then call grid_random routine
230      !!
231      !!              Apply the appropriate grid-point mask and lateral
232      !!              boundary conditions before exiting.
233      !!
234      !! ** Action  :
235      !!
236      !! References :
237      !!
238      !! History :
239      !!        !  09-07  (F. Vigilant) 
240      !!----------------------------------------------------------------------
241      !! * Modules used
242      USE par_oce       , ONLY: & ! Ocean space and time domain variables
243         & jpiglo
244      !! * Arguments
245      REAL, INTENT(INOUT), DIMENSION(jpi,jpj) :: &
246         & pt2d        ! 2D field
247      REAL(wp), INTENT(IN) :: &
248         & pmean, &    ! Mean of noise
249         & pstd        ! Standard deviation of noise
250
251      !! * Local declarations
252      CHARACTER(LEN=1), INTENT(IN) ::   &
253         & cd_type     ! Nature of pt2d grid-point
254                       !   = T , U  or V  grid-point
255      INTEGER :: &
256         & ji, &
257         & jj
258
259      !--------------------------------------------------------------------
260      ! Generate the noise
261      !--------------------------------------------------------------------
262      CALL grid_random( pt2d, cd_type, pmean, pstd )
263           
264   END SUBROUTINE grid_2d_rd_sd_loc
265
266   SUBROUTINE grid_3d_rd_sd_loc( pt3d, cd_type, pmean, pstd )
267      !!----------------------------------------------------------------------
268      !!               ***  ROUTINE grid_3d_rd_sd ***
269      !!         
270      !! ** Purpose : Fill a 3D array with uncorrelated Gaussian
271      !!              noise.
272      !!
273      !! ** Method  : The value of kseed is an integer from which a seed is
274      !!              generated for the random number
275      !!              and then call grid_random routine
276      !!
277      !!              Apply the appropriate grid-point mask and lateral
278      !!              boundary conditions before exiting.
279      !!
280      !! ** Action  :
281      !!
282      !! References :
283      !!
284      !! History :
285      !!        !  09-07  (F. Vigilant) 
286      !!----------------------------------------------------------------------
287      !! * Modules used
288      USE par_oce       , ONLY: & ! Ocean space and time domain variables
289         & jpiglo
290      !! * Arguments
291      REAL, INTENT(INOUT), DIMENSION(jpi,jpj,jpk) :: &
292         & pt3d        ! 3D field
293      REAL(wp), INTENT(IN) :: &
294         & pmean, &    ! Mean of noise
295         & pstd        ! Standard deviation of noise
296
297      !! * Local declarations
298      CHARACTER(LEN=1), INTENT(IN) ::   &
299         & cd_type     ! Nature of pt2d grid-point
300                       !   = T , U  or V  grid-point
301      INTEGER :: &
302         & ji, &
303         & jj
304
305
306      !--------------------------------------------------------------------
307      ! Generate the noise
308      !--------------------------------------------------------------------
309      CALL grid_random( pt3d, cd_type, pmean, pstd )
310           
311   END SUBROUTINE grid_3d_rd_sd_loc
312
313
314END MODULE gridrandom
Note: See TracBrowser for help on using the repository browser.