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.
domwri.F90 in branches/UKMO/r5936_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/r5936_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90 @ 7113

Last change on this file since 7113 was 7113, checked in by jcastill, 7 years ago

Remove again the svn keywords, as it did not work before

File size: 20.8 KB
Line 
1MODULE domwri
2   !!======================================================================
3   !!                       ***  MODULE domwri  ***
4   !! Ocean initialization : write the ocean domain mesh file(s)
5   !!======================================================================
6   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
7   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
8   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
9   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   dom_wri        : create and write mesh and mask file(s)
14   !!   dom_uniq       : identify unique point of a grid (TUVF)
15   !!----------------------------------------------------------------------
16   USE dom_oce         ! ocean space and time domain
17   USE in_out_manager  ! I/O manager
18   USE iom             ! I/O library
19   USE lbclnk          ! lateral boundary conditions - mpp exchanges
20   USE lib_mpp         ! MPP library
21   USE wrk_nemo        ! Memory allocation
22   USE timing          ! Timing
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   dom_wri              ! routine called by inidom.F90
28   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90
29   !! * Substitutions
30#  include "vectopt_loop_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
33   !! $Id$
34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36CONTAINS
37
38   SUBROUTINE dom_wri_coordinate
39      !!----------------------------------------------------------------------
40      !!                  ***  ROUTINE dom_wri_coordinate  ***
41      !!                   
42      !! ** Purpose :   Create the NetCDF file which contains all the
43      !!              standard coordinate information plus the surface,
44      !!              e1e2u and e1e2v. By doing so, those surface will
45      !!              not be changed by the reduction of e1u or e2v scale
46      !!              factors in some straits.
47      !!                 NB: call just after the read of standard coordinate
48      !!              and the reduction of scale factors in some straits
49      !!
50      !! ** output file :   coordinate_e1e2u_v.nc
51      !!----------------------------------------------------------------------
52      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file
53      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
54      !                                   !  workspaces
55      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
56      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
57      !!----------------------------------------------------------------------
58      !
59      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate')
60      !
61      IF(lwp) WRITE(numout,*)
62      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file'
63      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
64     
65      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations)
66     
67      !  create 'coordinate_e1e2u_v.nc' file
68      ! ============================
69      !
70      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
71      !
72      !                                                         ! horizontal mesh (inum3)
73      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
74      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 )
75      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 )
76      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 )
77     
78      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
79      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 )
80      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 )
81      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 )
82     
83      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
84      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 )
85      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 )
86      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 )
87     
88      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
89      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 )
90      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 )
91      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 )
92     
93      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 )
94      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 )
95
96      CALL iom_close( inum0 )
97      !
98      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate')
99      !
100   END SUBROUTINE dom_wri_coordinate
101
102
103   SUBROUTINE dom_wri
104      !!----------------------------------------------------------------------
105      !!                  ***  ROUTINE dom_wri  ***
106      !!                   
107      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
108      !!      ocean domain informations (mesh and mask arrays). This (these)
109      !!      file(s) is (are) used for visualisation (SAXO software) and
110      !!      diagnostic computation.
111      !!
112      !! ** Method  :   Write in a file all the arrays generated in routines
113      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
114      !!      the vertical coord. used (z-coord, partial steps, s-coord)
115      !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file
116      !!                         = 2  :   'mesh.nc' and mask.nc' files
117      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
118      !!                                  'mask.nc' files
119      !!      For huge size domain, use option 2 or 3 depending on your
120      !!      vertical coordinate.
121      !!
122      !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
123      !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays
124      !!                        corresponding to the depth of the bottom t- and w-points
125      !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the
126      !!                        thickness (e3[tw]_ps) of the bottom points
127      !!
128      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
129      !!                                   masks, depth and vertical scale factors
130      !!----------------------------------------------------------------------
131      !!
132      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
133      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
134      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
135      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
136      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
137      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
138      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
139      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
140      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
141      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
142      INTEGER           ::   ji, jj, jk   ! dummy loop indices
143      !                                   !  workspaces
144      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
145      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
146      !!----------------------------------------------------------------------
147      !
148      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
149      !
150      CALL wrk_alloc( jpi, jpj, zprt, zprw )
151      CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv )
152      !
153      IF(lwp) WRITE(numout,*)
154      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
155      IF(lwp) WRITE(numout,*) '~~~~~~~'
156     
157      clnam0 = 'mesh_mask'  ! filename (mesh and mask informations)
158      clnam1 = 'mesh'       ! filename (mesh informations)
159      clnam2 = 'mask'       ! filename (mask informations)
160      clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations)
161      clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations)
162     
163      SELECT CASE ( MOD(nmsh, 3) )
164         !                                  ! ============================
165      CASE ( 1 )                            !  create 'mesh_mask.nc' file
166         !                                  ! ============================
167         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
168         inum2 = inum0                                            ! put all the informations
169         inum3 = inum0                                            ! in unit inum0
170         inum4 = inum0
171         
172         !                                  ! ============================
173      CASE ( 2 )                            !  create 'mesh.nc' and
174         !                                  !         'mask.nc' files
175         !                                  ! ============================
176         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
177         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
178         inum3 = inum1                                            ! put mesh informations
179         inum4 = inum1                                            ! in unit inum1
180         !                                  ! ============================
181      CASE ( 0 )                            !  create 'mesh_hgr.nc'
182         !                                  !         'mesh_zgr.nc' and
183         !                                  !         'mask.nc'     files
184         !                                  ! ============================
185         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
186         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
187         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
188         !
189      END SELECT
190     
191      !                                                         ! masks (inum2)
192      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
193      CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 )
194      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 )
195      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 )
196     
197      CALL dom_uniq( zprw, 'T' )
198      DO jj = 1, jpj
199         DO ji = 1, jpi
200            jk=mikt(ji,jj) 
201            zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
202         END DO
203      END DO                             !    ! unique point mask
204      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 
205      CALL dom_uniq( zprw, 'U' )
206      DO jj = 1, jpj
207         DO ji = 1, jpi
208            jk=miku(ji,jj) 
209            zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
210         END DO
211      END DO
212      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 
213      CALL dom_uniq( zprw, 'V' )
214      DO jj = 1, jpj
215         DO ji = 1, jpi
216            jk=mikv(ji,jj) 
217            zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
218         END DO
219      END DO
220      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 
221      CALL dom_uniq( zprw, 'F' )
222      DO jj = 1, jpj
223         DO ji = 1, jpi
224            jk=mikf(ji,jj) 
225            zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
226         END DO
227      END DO
228      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 
229
230      !                                                         ! horizontal mesh (inum3)
231      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
232      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 )
233      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 )
234      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 )
235     
236      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
237      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 )
238      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 )
239      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 )
240     
241      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
242      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 )
243      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 )
244      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 )
245     
246      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
247      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 )
248      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 )
249      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 )
250     
251      CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor
252     
253      ! note that mbkt is set to 1 over land ==> use surface tmask
254      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
255      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
256      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
257      CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 )       !    ! nb of ocean T-points
258      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
259      CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r4 )       !    ! nb of ocean T-points
260           
261      IF( ln_sco ) THEN                                         ! s-coordinate
262         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )
263         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
264         CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv )
265         CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf )
266         !
267         CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
268         CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw ) 
269         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
270         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
271         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
272         !
273         CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors
274         CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
275         CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
276         CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
277         CALL iom_rstput( 0, 0, inum4, 'rx1', rx1 )             !    ! Max. grid stiffness ratio
278         !
279         CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
280         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
281         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
282         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )
283      ENDIF
284     
285      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
286         !
287         IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
288            CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         
289            CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
290            CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
291            CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
292         ELSE                                                   !    ! 2D masked bottom ocean scale factors
293            DO jj = 1,jpj   
294               DO ji = 1,jpi
295                  e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
296                  e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
297               END DO
298            END DO
299            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )     
300            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp )
301         END IF
302         !
303         IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
304            CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
305            DO jk = 1,jpk   
306               DO jj = 1, jpjm1   
307                  DO ji = 1, fs_jpim1   ! vector opt.
308                     zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) )
309                     zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk) )
310                  END DO   
311               END DO   
312            END DO
313            CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. ) 
314            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
315            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
316            CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )
317         ELSE                                                   !    ! 2D bottom depth
318            DO jj = 1,jpj   
319               DO ji = 1,jpi
320                  zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj)
321                  zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj)
322               END DO
323            END DO
324            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )     
325            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 
326         ENDIF
327         !
328         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord.
329         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
330         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )
331         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
332      ENDIF
333     
334      IF( ln_zco ) THEN
335         !                                                      ! z-coordinate - full steps
336         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth
337         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
338         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors
339         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
340      ENDIF
341      !                                     ! ============================
342      !                                     !        close the files
343      !                                     ! ============================
344      SELECT CASE ( MOD(nmsh, 3) )
345      CASE ( 1 )               
346         CALL iom_close( inum0 )
347      CASE ( 2 )
348         CALL iom_close( inum1 )
349         CALL iom_close( inum2 )
350      CASE ( 0 )
351         CALL iom_close( inum2 )
352         CALL iom_close( inum3 )
353         CALL iom_close( inum4 )
354      END SELECT
355      !
356      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
357      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
358      !
359      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
360      !
361   END SUBROUTINE dom_wri
362
363
364   SUBROUTINE dom_uniq( puniq, cdgrd )
365      !!----------------------------------------------------------------------
366      !!                  ***  ROUTINE dom_uniq  ***
367      !!                   
368      !! ** Purpose :   identify unique point of a grid (TUVF)
369      !!
370      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
371      !!                2) check which elements have been changed
372      !!----------------------------------------------------------------------
373      !
374      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !
375      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !
376      !
377      REAL(wp) ::  zshift   ! shift value link to the process number
378      INTEGER  ::  ji       ! dummy loop indices
379      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
380      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
381      !!----------------------------------------------------------------------
382      !
383      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
384      !
385      CALL wrk_alloc( jpi, jpj, ztstref )
386      !
387      ! build an array with different values for each element
388      ! in mpp: make sure that these values are different even between process
389      ! -> apply a shift value according to the process number
390      zshift = jpi * jpj * ( narea - 1 )
391      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
392      !
393      puniq(:,:) = ztstref(:,:)                   ! default definition
394      CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions
395      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed
396      !
397      puniq(:,:) = 1.                             ! default definition
398      ! fill only the inner part of the cpu with llbl converted into real
399      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
400      !
401      CALL wrk_dealloc( jpi, jpj, ztstref )
402      !
403      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
404      !
405   END SUBROUTINE dom_uniq
406
407   !!======================================================================
408END MODULE domwri
Note: See TracBrowser for help on using the repository browser.