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.
prtctl.F90 in branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90 @ 9125

Last change on this file since 9125 was 9125, checked in by timgraham, 6 years ago

Removed wrk_arrays from whole code. No change in SETTE results from this.
  • Property svn:keywords set to Id
File size: 24.4 KB
Line 
1MODULE prtctl
2   !!======================================================================
3   !!                       ***  MODULE prtctl   ***
4   !! Ocean system : print all SUM trends for each processor domain
5   !!======================================================================
6   !! History :  9.0  !  05-07  (C. Talandier) original code
7   !!            3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
8   !!----------------------------------------------------------------------
9   USE dom_oce          ! ocean space and time domain variables
10#if defined key_nemocice_decomp
11   USE ice_domain_size, only: nx_global, ny_global
12#endif
13   USE in_out_manager   ! I/O manager
14   USE lib_mpp          ! distributed memory computing
15
16   IMPLICIT NONE
17   PRIVATE
18
19   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid
20   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain
21   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain
22   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor
23   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain
24   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   !
25
26   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values
27   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values
28
29   INTEGER ::   ktime   ! time step
30
31   PUBLIC prt_ctl         ! called by all subroutines
32   PUBLIC prt_ctl_info    ! called by all subroutines
33   PUBLIC prt_ctl_init    ! called by opa.F90
34   PUBLIC sub_dom         ! called by opa.F90
35
36   !!----------------------------------------------------------------------
37   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   &
44      &                                  mask2, clinfo2, ovlap, kdim, clinfo3 )
45      !!----------------------------------------------------------------------
46      !!                     ***  ROUTINE prt_ctl  ***
47      !!
48      !! ** Purpose : - print sum control of 2D or 3D arrays over the same area
49      !!                in mono and mpp case. This way can be usefull when
50      !!                debugging a new parametrization in mono or mpp.
51      !!
52      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
53      !!                .true. in the ocean namelist:
54      !!              - to debug a MPI run .vs. a mono-processor one;
55      !!                the control print will be done over each sub-domain.
56      !!                The nictl[se] and njctl[se] parameters in the namelist must
57      !!                be set to zero and [ij]splt to the corresponding splitted
58      !!                domain in MPI along respectively i-, j- directions.
59      !!              - to debug a mono-processor run over the whole domain/a specific area;
60      !!                in the first case the nictl[se] and njctl[se] parameters must be set
61      !!                to zero else to the indices of the area to be controled. In both cases
62      !!                isplt and jsplt must be set to 1.
63      !!              - All arguments of the above calling sequence are optional so their
64      !!                name must be explicitly typed if used. For instance if the 3D
65      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine,
66      !!                it must looks like: CALL prt_ctl(tab3d_1=tn).
67      !!
68      !!                    tab2d_1 : first 2D array
69      !!                    tab3d_1 : first 3D array
70      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array
71      !!                    clinfo1 : information about the tab[23]d_1 array
72      !!                    tab2d_2 : second 2D array
73      !!                    tab3d_2 : second 3D array
74      !!                    mask2   : mask (3D) to apply to the tab[23]d_2 array
75      !!                    clinfo2 : information about the tab[23]d_2 array
76      !!                    ovlap   : overlap value
77      !!                    kdim    : k- direction for 3D arrays
78      !!                    clinfo3 : additional information
79      !!----------------------------------------------------------------------
80      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1
81      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1
82      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1
83      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1
84      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2
85      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2
86      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2
87      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2
88      INTEGER                   , INTENT(in), OPTIONAL ::   ovlap
89      INTEGER                   , INTENT(in), OPTIONAL ::   kdim
90      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3
91      !
92      CHARACTER (len=15) :: cl2
93      INTEGER ::   overlap, jn, sind, eind, kdir,j_id
94      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
95      REAL(wp), DIMENSION(jpi,jpj)     :: ztab2d_1, ztab2d_2
96      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2
97      !!----------------------------------------------------------------------
98
99      ! Arrays, scalars initialization
100      overlap   = 0
101      kdir      = jpkm1
102      cl2       = ''
103      zsum1     = 0.e0
104      zsum2     = 0.e0
105      zvctl1    = 0.e0
106      zvctl2    = 0.e0
107      ztab2d_1(:,:)   = 0.e0
108      ztab2d_2(:,:)   = 0.e0
109      ztab3d_1(:,:,:) = 0.e0
110      ztab3d_2(:,:,:) = 0.e0
111      zmask1  (:,:,:) = 1.e0
112      zmask2  (:,:,:) = 1.e0
113
114      ! Control of optional arguments
115      IF( PRESENT(clinfo2) )   cl2                  = clinfo2
116      IF( PRESENT(ovlap)   )   overlap              = ovlap
117      IF( PRESENT(kdim)    )   kdir                 = kdim
118      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:)
119      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:)
120      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir)
121      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir)
122      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:)
123      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:)
124
125      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
126         sind = narea
127         eind = narea
128      ELSE                                    ! processors total number
129         sind = 1
130         eind = ijsplt
131      ENDIF
132
133      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
134      DO jn = sind, eind
135         ! Set logical unit
136         j_id = numid(jn - narea + 1)
137         ! Set indices for the SUM control
138         IF( .NOT. lsp_area ) THEN
139            IF (lk_mpp .AND. jpnij > 1)   THEN
140               nictls = MAX( 1, nlditl(jn) - overlap )
141               nictle = nleitl(jn) + overlap * MIN( 1, nlcitl(jn) - nleitl(jn)) 
142               njctls = MAX( 1, nldjtl(jn) - overlap )
143               njctle = nlejtl(jn) + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn))
144               ! Do not take into account the bound of the domain
145               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
146               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
147               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1)
148               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1)
149            ELSE
150               nictls = MAX( 1, nimpptl(jn) + nlditl(jn) - 1 - overlap )
151               nictle = nimpptl(jn) + nleitl(jn) - 1 + overlap * MIN( 1, nlcitl(jn) - nleitl(jn) ) 
152               njctls = MAX( 1, njmpptl(jn) + nldjtl(jn) - 1 - overlap )
153               njctle = njmpptl(jn) + nlejtl(jn) - 1 + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn) ) 
154               ! Do not take into account the bound of the domain
155               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
156               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
157               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2)
158               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2)
159            ENDIF
160         ENDIF
161
162         IF( PRESENT(clinfo3)) THEN
163            IF ( clinfo3 == 'tra' )  THEN
164               zvctl1 = t_ctll(jn)
165               zvctl2 = s_ctll(jn)
166            ELSEIF ( clinfo3 == 'dyn' )   THEN
167               zvctl1 = u_ctll(jn)
168               zvctl2 = v_ctll(jn)
169            ENDIF
170         ENDIF
171
172         ! Compute the sum control
173         ! 2D arrays
174         IF( PRESENT(tab2d_1) )   THEN
175            zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) )
176            zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) )
177         ENDIF
178
179         ! 3D arrays
180         IF( PRESENT(tab3d_1) )   THEN
181            zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) )
182            zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) )
183         ENDIF
184
185         ! Print the result
186         IF( PRESENT(clinfo3) )   THEN
187            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2
188            SELECT CASE( clinfo3 )
189            CASE ( 'tra-ta' ) 
190               t_ctll(jn) = zsum1
191            CASE ( 'tra' ) 
192                t_ctll(jn) = zsum1
193                s_ctll(jn) = zsum2
194            CASE ( 'dyn' ) 
195                u_ctll(jn) = zsum1
196                v_ctll(jn) = zsum2 
197            END SELECT
198         ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
199            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
200         ELSE
201            WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1
202         ENDIF
203
204      ENDDO
205      !
206   END SUBROUTINE prt_ctl
207
208
209   SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime)
210      !!----------------------------------------------------------------------
211      !!                     ***  ROUTINE prt_ctl_info  ***
212      !!
213      !! ** Purpose : - print information without any computation
214      !!
215      !! ** Action  : - input arguments
216      !!                    clinfo1 : information about the ivar1
217      !!                    ivar1   : value to print
218      !!                    clinfo2 : information about the ivar2
219      !!                    ivar2   : value to print
220      !!----------------------------------------------------------------------
221      CHARACTER (len=*), INTENT(in)           ::   clinfo1
222      INTEGER          , INTENT(in), OPTIONAL ::   ivar1
223      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2
224      INTEGER          , INTENT(in), OPTIONAL ::   ivar2
225      INTEGER          , INTENT(in), OPTIONAL ::   itime
226      !
227      INTEGER :: jn, sind, eind, iltime, j_id
228      !!----------------------------------------------------------------------
229
230      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
231         sind = narea
232         eind = narea
233      ELSE                                    ! total number of processors
234         sind = 1
235         eind = ijsplt
236      ENDIF
237
238      ! Set to zero arrays at each new time step
239      IF( PRESENT(itime) )   THEN
240         iltime = itime
241         IF( iltime > ktime )   THEN
242            t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0
243            u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0
244            ktime = iltime
245         ENDIF
246      ENDIF
247
248      ! Loop over each sub-domain, i.e. number of processors ijsplt
249      DO jn = sind, eind
250         !
251         j_id = numid(jn - narea + 1)         ! Set logical unit
252         !
253         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
254            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2
255         ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
256            WRITE(j_id,*)clinfo1, ivar1, clinfo2
257         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
258            WRITE(j_id,*)clinfo1, ivar1, ivar2
259         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
260            WRITE(j_id,*)clinfo1, ivar1
261         ELSE
262            WRITE(j_id,*)clinfo1
263         ENDIF
264         !
265      END DO
266      !
267   END SUBROUTINE prt_ctl_info
268
269
270   SUBROUTINE prt_ctl_init
271      !!----------------------------------------------------------------------
272      !!                     ***  ROUTINE prt_ctl_init  ***
273      !!
274      !! ** Purpose :   open ASCII files & compute indices
275      !!----------------------------------------------------------------------
276      INTEGER ::   jn, sind, eind, j_id
277      CHARACTER (len=28) :: clfile_out
278      CHARACTER (len=23) :: clb_name
279      CHARACTER (len=19) :: cl_run
280      !!----------------------------------------------------------------------
281
282      ! Allocate arrays
283      ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   &
284         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   &
285         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     &
286         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       )
287
288      ! Initialization
289      t_ctll(:) = 0.e0
290      s_ctll(:) = 0.e0
291      u_ctll(:) = 0.e0
292      v_ctll(:) = 0.e0
293      ktime = 1
294
295      IF( lk_mpp .AND. jpnij > 1 ) THEN
296         sind = narea
297         eind = narea
298         clb_name = "('mpp.output_',I4.4)"
299         cl_run = 'MULTI processor run'
300         ! use indices for each area computed by mpp_init subroutine
301         nlditl(1:jpnij) = nldit(:) 
302         nleitl(1:jpnij) = nleit(:) 
303         nldjtl(1:jpnij) = nldjt(:) 
304         nlejtl(1:jpnij) = nlejt(:) 
305         !
306         nimpptl(1:jpnij) = nimppt(:)
307         njmpptl(1:jpnij) = njmppt(:)
308         !
309         nlcitl(1:jpnij) = nlcit(:)
310         nlcjtl(1:jpnij) = nlcjt(:)
311         !
312         ibonitl(1:jpnij) = ibonit(:)
313         ibonjtl(1:jpnij) = ibonjt(:)
314      ELSE
315         sind = 1
316         eind = ijsplt
317         clb_name = "('mono.output_',I4.4)"
318         cl_run = 'MONO processor run '
319         ! compute indices for each area as done in mpp_init subroutine
320         CALL sub_dom
321      ENDIF
322
323      ALLOCATE( numid(eind-sind+1) )
324
325      DO jn = sind, eind
326         WRITE(clfile_out,FMT=clb_name) jn-1
327         CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
328         j_id = numid(jn -narea + 1)
329         WRITE(j_id,*)
330         WRITE(j_id,*) '                 L O D Y C - I P S L'
331         WRITE(j_id,*) '                     O P A model'
332         WRITE(j_id,*) '            Ocean General Circulation Model'
333         WRITE(j_id,*) '               version OPA 9.0  (2005) '
334         WRITE(j_id,*)
335         WRITE(j_id,*) '                   PROC number: ', jn
336         WRITE(j_id,*)
337         WRITE(j_id,FMT="(19x,a20)")cl_run
338
339         ! Print the SUM control indices
340         IF( .NOT. lsp_area )   THEN
341            nictls = nimpptl(jn) + nlditl(jn) - 1
342            nictle = nimpptl(jn) + nleitl(jn) - 1
343            njctls = njmpptl(jn) + nldjtl(jn) - 1
344            njctle = njmpptl(jn) + nlejtl(jn) - 1
345         ENDIF
346         WRITE(j_id,*) 
347         WRITE(j_id,*) 'prt_ctl :  Sum control indices'
348         WRITE(j_id,*) '~~~~~~~'
349         WRITE(j_id,*)
350         WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              '
351         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
352         WRITE(j_id,9001)'                  |                                       |'
353         WRITE(j_id,9001)'                  |                                       |'
354         WRITE(j_id,9001)'                  |                                       |'
355         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
356         WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn)
357         WRITE(j_id,9001)'                  |                                       |'
358         WRITE(j_id,9001)'                  |                                       |'
359         WRITE(j_id,9001)'                  |                                       |'
360         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------'
361         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              '
362         WRITE(j_id,*)
363         WRITE(j_id,*)
364
3659000     FORMAT(a41,i4.4,a14)
3669001     FORMAT(a59)
3679002     FORMAT(a20,i4.4,a36,i3.3)
3689003     FORMAT(a20,i4.4,a17,i4.4)
3699004     FORMAT(a11,i4.4,a26,i4.4,a14)
370      END DO
371      !
372   END SUBROUTINE prt_ctl_init
373
374
375   SUBROUTINE sub_dom
376      !!----------------------------------------------------------------------
377      !!                  ***  ROUTINE sub_dom  ***
378      !!                   
379      !! ** Purpose :   Lay out the global domain over processors.
380      !!                CAUTION:
381      !!                This part has been extracted from the mpp_init
382      !!                subroutine and names of variables/arrays have been
383      !!                slightly changed to avoid confusion but the computation
384      !!                is exactly the same. Any modification about indices of
385      !!                each sub-domain in the mppini.F90 module should be reported
386      !!                here.
387      !!
388      !! ** Method  :   Global domain is distributed in smaller local domains.
389      !!                Periodic condition is a function of the local domain position
390      !!                (global boundary or neighbouring domain) and of the global
391      !!                periodic
392      !!                Type :         jperio global periodic condition
393      !!                               nperio local  periodic condition
394      !!
395      !! ** Action  : - set domain parameters
396      !!                    nimpp     : longitudinal index
397      !!                    njmpp     : latitudinal  index
398      !!                    nperio    : lateral condition type
399      !!                    narea     : number for local area
400      !!                    nlcil      : first dimension
401      !!                    nlcjl      : second dimension
402      !!                    nbondil    : mark for "east-west local boundary"
403      !!                    nbondjl    : mark for "north-south local boundary"
404      !!
405      !! History :
406      !!        !  94-11  (M. Guyon)  Original code
407      !!        !  95-04  (J. Escobar, M. Imbard)
408      !!        !  98-02  (M. Guyon)  FETI method
409      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
410      !!   8.5  !  02-08  (G. Madec)  F90 : free form
411      !!----------------------------------------------------------------------
412      INTEGER ::   ji, jj, jn               ! dummy loop indices
413      INTEGER ::   &
414         ii, ij,                         &  ! temporary integers
415         irestil, irestjl,               &  !    "          "
416         ijpi  , ijpj, nlcil,            &  ! temporary logical unit
417         nlcjl , nbondil, nbondjl,       &
418         nrecil, nrecjl, nldil, nleil, nldjl, nlejl
419
420      INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
421      REAL(wp) ::   zidom, zjdom            ! temporary scalars
422      !!----------------------------------------------------------------------
423
424      !
425      !
426      !  1. Dimension arrays for subdomains
427      ! -----------------------------------
428      !  Computation of local domain sizes ilcitl() ilcjtl()
429      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
430      !  The subdomains are squares leeser than or equal to the global
431      !  dimensions divided by the number of processors minus the overlap
432      !  array (cf. par_oce.F90).
433
434#if defined key_nemocice_decomp
435      ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls
436      ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 
437#else
438      ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls
439      ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls
440#endif
441
442
443      nrecil  = 2 * nn_hls
444      nrecjl  = 2 * nn_hls
445      irestil = MOD( jpiglo - nrecil , isplt )
446      irestjl = MOD( jpjglo - nrecjl , jsplt )
447
448      IF(  irestil == 0 )   irestil = isplt
449#if defined key_nemocice_decomp
450
451      ! In order to match CICE the size of domains in NEMO has to be changed
452      ! The last line of blocks (west) will have fewer points
453      DO jj = 1, jsplt 
454         DO ji=1, isplt-1 
455            ilcitl(ji,jj) = ijpi 
456         END DO
457         ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil)
458      END DO 
459
460#else
461
462      DO jj = 1, jsplt
463         DO ji = 1, irestil
464            ilcitl(ji,jj) = ijpi
465         END DO
466         DO ji = irestil+1, isplt
467            ilcitl(ji,jj) = ijpi -1
468         END DO
469      END DO
470
471#endif
472     
473      IF( irestjl == 0 )   irestjl = jsplt
474#if defined key_nemocice_decomp 
475
476      ! Same change to domains in North-South direction as in East-West.
477      DO ji = 1, isplt 
478         DO jj=1, jsplt-1 
479            ilcjtl(ji,jj) = ijpj 
480         END DO
481         ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl)
482      END DO 
483
484#else
485
486      DO ji = 1, isplt
487         DO jj = 1, irestjl
488            ilcjtl(ji,jj) = ijpj
489         END DO
490         DO jj = irestjl+1, jsplt
491            ilcjtl(ji,jj) = ijpj -1
492         END DO
493      END DO
494
495#endif
496      zidom = nrecil
497      DO ji = 1, isplt
498         zidom = zidom + ilcitl(ji,1) - nrecil
499      END DO
500      IF(lwp) WRITE(numout,*)
501      IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo
502     
503      zjdom = nrecjl
504      DO jj = 1, jsplt
505         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
506      END DO
507      IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo
508      IF(lwp) WRITE(numout,*)
509     
510
511      !  2. Index arrays for subdomains
512      ! -------------------------------
513
514      iimpptl(:,:) = 1
515      ijmpptl(:,:) = 1
516     
517      IF( isplt > 1 ) THEN
518         DO jj = 1, jsplt
519            DO ji = 2, isplt
520               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
521            END DO
522         END DO
523      ENDIF
524
525      IF( jsplt > 1 ) THEN
526         DO jj = 2, jsplt
527            DO ji = 1, isplt
528               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
529            END DO
530         END DO
531      ENDIF
532     
533      ! 3. Subdomain description
534      ! ------------------------
535
536      DO jn = 1, ijsplt
537         ii = 1 + MOD( jn-1, isplt )
538         ij = 1 + (jn-1) / isplt
539         nimpptl(jn) = iimpptl(ii,ij)
540         njmpptl(jn) = ijmpptl(ii,ij)
541         nlcitl (jn) = ilcitl (ii,ij)     
542         nlcil       = nlcitl (jn)     
543         nlcjtl (jn) = ilcjtl (ii,ij)     
544         nlcjl       = nlcjtl (jn)
545         nbondjl = -1                                    ! general case
546         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor
547         IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
548         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
549         ibonjtl(jn) = nbondjl
550         
551         nbondil = 0                                     !
552         IF( MOD( jn, isplt ) == 1 )   nbondil = -1      !
553         IF( MOD( jn, isplt ) == 0 )   nbondil =  1      !
554         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
555         ibonitl(jn) = nbondil
556         
557         nldil =  1   + nn_hls
558         nleil = nlcil - nn_hls
559         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
560         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
561         nldjl =  1   + nn_hls
562         nlejl = nlcjl - nn_hls
563         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
564         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
565         nlditl(jn) = nldil
566         nleitl(jn) = nleil
567         nldjtl(jn) = nldjl
568         nlejtl(jn) = nlejl
569      END DO
570      !
571      !
572      !
573   END SUBROUTINE sub_dom
574
575   !!======================================================================
576END MODULE prtctl
Note: See TracBrowser for help on using the repository browser.