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 NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/IOM – NEMO

source: NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/IOM/prtctl.F90 @ 12942

Last change on this file since 12942 was 12942, checked in by hadcv, 3 years ago

Correct/improve IF blocks for one tile code

  • Property svn:keywords set to Id
File size: 24.8 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 ::   nis0allp, njs0allp   ! first, last indoor index for each i-domain
21   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nie0allp, nje0allp   ! 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 ::    jpiallp,  jpjallp   ! 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/OCE 4.0 , NEMO Consortium (2018)
38   !! $Id$
39   !! Software governed by the CeCILL license (see ./LICENSE)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   &
44      &                                  mask2, clinfo2, 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 sn_cfctl%prtctl 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 look 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      !!                    kdim    : k- direction for 3D arrays
77      !!                    clinfo3 : additional information
78      !!----------------------------------------------------------------------
79      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1
80      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1
81      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1
82      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1
83      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2
84      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2
85      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2
86      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2
87      INTEGER                   , INTENT(in), OPTIONAL ::   kdim
88      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3
89      !
90      CHARACTER (len=15) :: cl2
91      INTEGER ::  jn, sind, eind, kdir,j_id
92      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
93      REAL(wp), DIMENSION(jpi,jpj)     :: ztab2d_1, ztab2d_2
94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2
95      !!----------------------------------------------------------------------
96      ! TODO: TO BE TILED
97      IF( ntile /= 0 .AND. ntile /= nijtile ) RETURN
98
99      ! Arrays, scalars initialization
100      kdir      = jpkm1
101      cl2       = ''
102      zsum1     = 0.e0
103      zsum2     = 0.e0
104      zvctl1    = 0.e0
105      zvctl2    = 0.e0
106      ztab2d_1(:,:)   = 0.e0
107      ztab2d_2(:,:)   = 0.e0
108      ztab3d_1(:,:,:) = 0.e0
109      ztab3d_2(:,:,:) = 0.e0
110      zmask1  (:,:,:) = 1.e0
111      zmask2  (:,:,:) = 1.e0
112
113      ! Control of optional arguments
114      IF( PRESENT(clinfo2) )   cl2                  = clinfo2
115      IF( PRESENT(kdim)    )   kdir                 = kdim
116      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:)
117      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:)
118      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir)
119      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir)
120      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:)
121      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:)
122
123      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
124         sind = narea
125         eind = narea
126      ELSE                                    ! processors total number
127         sind = 1
128         eind = ijsplt
129      ENDIF
130
131      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
132      DO jn = sind, eind
133         ! Set logical unit
134         j_id = numid(jn - narea + 1)
135         ! Set indices for the SUM control
136         IF( .NOT. lsp_area ) THEN
137            IF (lk_mpp .AND. jpnij > 1)   THEN
138               nictls = MAX(  1, nis0allp(jn) )
139               nictle = MIN(jpi, nie0allp(jn) )
140               njctls = MAX(  1, njs0allp(jn) )
141               njctle = MIN(jpj, nje0allp(jn) )
142               ! Do not take into account the bound of the domain
143               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
144               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
145               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nie0allp(jn) - 1)
146               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nje0allp(jn) - 1)
147            ELSE
148               nictls = MAX(  1, nimpptl(jn) - 1 + nis0allp(jn) )
149               nictle = MIN(jpi, nimpptl(jn) - 1 + nie0allp(jn) )
150               njctls = MAX(  1, njmpptl(jn) - 1 + njs0allp(jn) )
151               njctle = MIN(jpj, njmpptl(jn) - 1 + nje0allp(jn) )
152               ! Do not take into account the bound of the domain
153               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
154               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
155               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nie0allp(jn) - 2)
156               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nje0allp(jn) - 2)
157            ENDIF
158         ENDIF
159
160         IF( PRESENT(clinfo3)) THEN
161            IF ( clinfo3 == 'tra' )  THEN
162               zvctl1 = t_ctll(jn)
163               zvctl2 = s_ctll(jn)
164            ELSEIF ( clinfo3 == 'dyn' )   THEN
165               zvctl1 = u_ctll(jn)
166               zvctl2 = v_ctll(jn)
167            ENDIF
168         ENDIF
169
170         ! Compute the sum control
171         ! 2D arrays
172         IF( PRESENT(tab2d_1) )   THEN
173            zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) )
174            zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) )
175         ENDIF
176
177         ! 3D arrays
178         IF( PRESENT(tab3d_1) )   THEN
179            zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) )
180            zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) )
181         ENDIF
182
183         ! Print the result
184         IF( PRESENT(clinfo3) )   THEN
185            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2
186            SELECT CASE( clinfo3 )
187            CASE ( 'tra-ta' ) 
188               t_ctll(jn) = zsum1
189            CASE ( 'tra' ) 
190                t_ctll(jn) = zsum1
191                s_ctll(jn) = zsum2
192            CASE ( 'dyn' ) 
193                u_ctll(jn) = zsum1
194                v_ctll(jn) = zsum2 
195            END SELECT
196         ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
197            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
198         ELSE
199            WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1
200         ENDIF
201
202      ENDDO
203      !
204   END SUBROUTINE prt_ctl
205
206
207   SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime)
208      !!----------------------------------------------------------------------
209      !!                     ***  ROUTINE prt_ctl_info  ***
210      !!
211      !! ** Purpose : - print information without any computation
212      !!
213      !! ** Action  : - input arguments
214      !!                    clinfo1 : information about the ivar1
215      !!                    ivar1   : value to print
216      !!                    clinfo2 : information about the ivar2
217      !!                    ivar2   : value to print
218      !!----------------------------------------------------------------------
219      CHARACTER (len=*), INTENT(in)           ::   clinfo1
220      INTEGER          , INTENT(in), OPTIONAL ::   ivar1
221      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2
222      INTEGER          , INTENT(in), OPTIONAL ::   ivar2
223      INTEGER          , INTENT(in), OPTIONAL ::   itime
224      !
225      INTEGER :: jn, sind, eind, iltime, j_id
226      !!----------------------------------------------------------------------
227
228      IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number
229         sind = narea
230         eind = narea
231      ELSE                                    ! total number of processors
232         sind = 1
233         eind = ijsplt
234      ENDIF
235
236      ! Set to zero arrays at each new time step
237      IF( PRESENT(itime) )   THEN
238         iltime = itime
239         IF( iltime > ktime )   THEN
240            t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0
241            u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0
242            ktime = iltime
243         ENDIF
244      ENDIF
245
246      ! Loop over each sub-domain, i.e. number of processors ijsplt
247      DO jn = sind, eind
248         !
249         j_id = numid(jn - narea + 1)         ! Set logical unit
250         !
251         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
252            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2
253         ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
254            WRITE(j_id,*)clinfo1, ivar1, clinfo2
255         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
256            WRITE(j_id,*)clinfo1, ivar1, ivar2
257         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
258            WRITE(j_id,*)clinfo1, ivar1
259         ELSE
260            WRITE(j_id,*)clinfo1
261         ENDIF
262         !
263      END DO
264      !
265   END SUBROUTINE prt_ctl_info
266
267
268   SUBROUTINE prt_ctl_init
269      !!----------------------------------------------------------------------
270      !!                     ***  ROUTINE prt_ctl_init  ***
271      !!
272      !! ** Purpose :   open ASCII files & compute indices
273      !!----------------------------------------------------------------------
274      INTEGER ::   jn, sind, eind, j_id
275      CHARACTER (len=28) :: clfile_out
276      CHARACTER (len=23) :: clb_name
277      CHARACTER (len=19) :: cl_run
278      !!----------------------------------------------------------------------
279
280      ! Allocate arrays
281      ALLOCATE( nis0allp(ijsplt) , nie0allp(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   &
282         &      njs0allp(ijsplt) , nje0allp(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   &
283         &       jpiallp(ijsplt) ,   t_ctll(ijsplt) ,  u_ctll(ijsplt) ,                     &
284         &       jpjallp(ijsplt) ,   s_ctll(ijsplt) ,  v_ctll(ijsplt)                       )
285
286      ! Initialization
287      t_ctll(:) = 0.e0
288      s_ctll(:) = 0.e0
289      u_ctll(:) = 0.e0
290      v_ctll(:) = 0.e0
291      ktime = 1
292
293      IF( lk_mpp .AND. jpnij > 1 ) THEN
294         sind = narea
295         eind = narea
296         clb_name = "('mpp.output_',I4.4)"
297         cl_run = 'MULTI processor run'
298         ! use indices for each area computed by mpp_init subroutine
299         nis0allp(1:jpnij) = nis0all(:) 
300         nie0allp(1:jpnij) = nie0all(:) 
301         njs0allp(1:jpnij) = njs0all(:) 
302         nje0allp(1:jpnij) = nje0all(:) 
303         !
304         nimpptl(1:jpnij) = nimppt(:)
305         njmpptl(1:jpnij) = njmppt(:)
306         !
307         jpiallp(1:jpnij) = jpiall(:)
308         jpjallp(1:jpnij) = jpjall(:)
309         !
310         ibonitl(1:jpnij) = ibonit(:)
311         ibonjtl(1:jpnij) = ibonjt(:)
312      ELSE
313         sind = 1
314         eind = ijsplt
315         clb_name = "('mono.output_',I4.4)"
316         cl_run = 'MONO processor run '
317         ! compute indices for each area as done in mpp_init subroutine
318         CALL sub_dom
319      ENDIF
320
321      ALLOCATE( numid(eind-sind+1) )
322
323      DO jn = sind, eind
324         WRITE(clfile_out,FMT=clb_name) jn-1
325         CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
326         j_id = numid(jn -narea + 1)
327         WRITE(j_id,*)
328         WRITE(j_id,*) '                 L O D Y C - I P S L'
329         WRITE(j_id,*) '                     O P A model'
330         WRITE(j_id,*) '            Ocean General Circulation Model'
331         WRITE(j_id,*) '               version OPA 9.0  (2005) '
332         WRITE(j_id,*)
333         WRITE(j_id,*) '                   PROC number: ', jn
334         WRITE(j_id,*)
335         WRITE(j_id,FMT="(19x,a20)")cl_run
336
337         ! Print the SUM control indices
338         IF( .NOT. lsp_area )   THEN
339            nictls = nimpptl(jn) + nis0allp(jn) - 1
340            nictle = nimpptl(jn) + nie0allp(jn) - 1
341            njctls = njmpptl(jn) + njs0allp(jn) - 1
342            njctle = njmpptl(jn) + nje0allp(jn) - 1
343         ENDIF
344         WRITE(j_id,*) 
345         WRITE(j_id,*) 'prt_ctl :  Sum control indices'
346         WRITE(j_id,*) '~~~~~~~'
347         WRITE(j_id,*)
348         WRITE(j_id,9000)'                                Nje0   = ', nje0allp(jn), '              '
349         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
350         WRITE(j_id,9001)'                  |                                       |'
351         WRITE(j_id,9001)'                  |                                       |'
352         WRITE(j_id,9001)'                  |                                       |'
353         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
354         WRITE(j_id,9002)'           Nis0   = ', nis0allp(jn),  '                           Nie0   = ', nie0allp(jn)
355         WRITE(j_id,9001)'                  |                                       |'
356         WRITE(j_id,9001)'                  |                                       |'
357         WRITE(j_id,9001)'                  |                                       |'
358         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------'
359         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        Njs0   = ', njs0allp(jn), '              '
360         WRITE(j_id,*)
361         WRITE(j_id,*)
362
3639000     FORMAT(a41,i4.4,a14)
3649001     FORMAT(a59)
3659002     FORMAT(a20,i4.4,a36,i3.3)
3669003     FORMAT(a20,i4.4,a17,i4.4)
3679004     FORMAT(a11,i4.4,a26,i4.4,a14)
368      END DO
369      !
370   END SUBROUTINE prt_ctl_init
371
372
373   SUBROUTINE sub_dom
374      !!----------------------------------------------------------------------
375      !!                  ***  ROUTINE sub_dom  ***
376      !!                   
377      !! ** Purpose :   Lay out the global domain over processors.
378      !!                CAUTION:
379      !!                This part has been extracted from the mpp_init
380      !!                subroutine and names of variables/arrays have been
381      !!                slightly changed to avoid confusion but the computation
382      !!                is exactly the same. Any modification about indices of
383      !!                each sub-domain in the mppini.F90 module should be reported
384      !!                here.
385      !!
386      !! ** Method  :   Global domain is distributed in smaller local domains.
387      !!                Periodic condition is a function of the local domain position
388      !!                (global boundary or neighbouring domain) and of the global
389      !!                periodic
390      !!                Type :         jperio global periodic condition
391      !!
392      !! ** Action  : - set domain parameters
393      !!                    nimpp     : longitudinal index
394      !!                    njmpp     : latitudinal  index
395      !!                    narea     : number for local area
396      !!                    ipil      : first dimension
397      !!                    ipjl      : second dimension
398      !!                    nbondil    : mark for "east-west local boundary"
399      !!                    nbondjl    : mark for "north-south local boundary"
400      !!
401      !! History :
402      !!        !  94-11  (M. Guyon)  Original code
403      !!        !  95-04  (J. Escobar, M. Imbard)
404      !!        !  98-02  (M. Guyon)  FETI method
405      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
406      !!   8.5  !  02-08  (G. Madec)  F90 : free form
407      !!----------------------------------------------------------------------
408      INTEGER ::   ji, jj, jn               ! dummy loop indices
409      INTEGER ::   &
410         ii, ij,                         &  ! temporary integers
411         irestil, irestjl,               &  !    "          "
412         ijpi  , ijpj, ipil,             &  ! temporary logical unit
413         ipjl , nbondil, nbondjl,        &
414         nrecil, nrecjl, Nis0l, Nie0l, Njs0l, Nje0l
415
416      INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ijpitl, ijpjtl   ! workspace
417      REAL(wp) ::   zidom, zjdom            ! temporary scalars
418      INTEGER ::   inum                     ! local logical unit
419      !!----------------------------------------------------------------------
420
421      !
422      !
423      !  1. Dimension arrays for subdomains
424      ! -----------------------------------
425      !  Computation of local domain sizes ijpitl() ijpjtl()
426      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
427      !  The subdomains are squares leeser than or equal to the global
428      !  dimensions divided by the number of processors minus the overlap
429      !  array (cf. par_oce.F90).
430
431#if defined key_nemocice_decomp
432      ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls
433      ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 
434#else
435      ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls
436      ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls
437#endif
438
439
440      nrecil  = 2 * nn_hls
441      nrecjl  = 2 * nn_hls
442      irestil = MOD( jpiglo - nrecil , isplt )
443      irestjl = MOD( jpjglo - nrecjl , jsplt )
444
445      IF(  irestil == 0 )   irestil = isplt
446#if defined key_nemocice_decomp
447
448      ! In order to match CICE the size of domains in NEMO has to be changed
449      ! The last line of blocks (west) will have fewer points
450      DO jj = 1, jsplt 
451         DO ji=1, isplt-1 
452            ijpitl(ji,jj) = ijpi 
453         END DO
454         ijpitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil)
455      END DO 
456
457#else
458
459      DO jj = 1, jsplt
460         DO ji = 1, irestil
461            ijpitl(ji,jj) = ijpi
462         END DO
463         DO ji = irestil+1, isplt
464            ijpitl(ji,jj) = ijpi -1
465         END DO
466      END DO
467
468#endif
469     
470      IF( irestjl == 0 )   irestjl = jsplt
471#if defined key_nemocice_decomp 
472
473      ! Same change to domains in North-South direction as in East-West.
474      DO ji = 1, isplt 
475         DO jj=1, jsplt-1 
476            ijpjtl(ji,jj) = ijpj 
477         END DO
478         ijpjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl)
479      END DO 
480
481#else
482
483      DO ji = 1, isplt
484         DO jj = 1, irestjl
485            ijpjtl(ji,jj) = ijpj
486         END DO
487         DO jj = irestjl+1, jsplt
488            ijpjtl(ji,jj) = ijpj -1
489         END DO
490      END DO
491
492#endif
493      zidom = nrecil
494      DO ji = 1, isplt
495         zidom = zidom + ijpitl(ji,1) - nrecil
496      END DO
497      IF(lwp) WRITE(numout,*)
498      IF(lwp) WRITE(numout,*)' sum ijpitl(i,1) = ', zidom, ' jpiglo = ', jpiglo
499     
500      zjdom = nrecjl
501      DO jj = 1, jsplt
502         zjdom = zjdom + ijpjtl(1,jj) - nrecjl
503      END DO
504      IF(lwp) WRITE(numout,*)' sum ijpitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo
505      IF(lwp) WRITE(numout,*)
506     
507
508      !  2. Index arrays for subdomains
509      ! -------------------------------
510
511      iimpptl(:,:) = 1
512      ijmpptl(:,:) = 1
513     
514      IF( isplt > 1 ) THEN
515         DO jj = 1, jsplt
516            DO ji = 2, isplt
517               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ijpitl(ji-1,jj) - nrecil
518            END DO
519         END DO
520      ENDIF
521
522      IF( jsplt > 1 ) THEN
523         DO jj = 2, jsplt
524            DO ji = 1, isplt
525               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ijpjtl(ji,jj-1)-nrecjl
526            END DO
527         END DO
528      ENDIF
529     
530      ! 3. Subdomain description
531      ! ------------------------
532
533      DO jn = 1, ijsplt
534         ii = 1 + MOD( jn-1, isplt )
535         ij = 1 + (jn-1) / isplt
536         nimpptl(jn) = iimpptl(ii,ij)
537         njmpptl(jn) = ijmpptl(ii,ij)
538         jpiallp(jn) = ijpitl (ii,ij)     
539         ipil        = jpiallp(jn)     
540         jpjallp(jn) = ijpjtl (ii,ij)     
541         ipjl        = jpjallp(jn)
542         nbondjl = -1                                    ! general case
543         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor
544         IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
545         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
546         ibonjtl(jn) = nbondjl
547         
548         nbondil = 0                                     !
549         IF( MOD( jn, isplt ) == 1 )   nbondil = -1      !
550         IF( MOD( jn, isplt ) == 0 )   nbondil =  1      !
551         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
552         ibonitl(jn) = nbondil
553         
554         Nis0l =  1   + nn_hls
555         Nie0l = ipil - nn_hls
556         IF( nbondil == -1 .OR. nbondil == 2 )   Nis0l = 1
557         IF( nbondil ==  1 .OR. nbondil == 2 )   Nie0l = ipil
558         Njs0l =  1   + nn_hls
559         Nje0l = ipjl - nn_hls
560         IF( nbondjl == -1 .OR. nbondjl == 2 )   Njs0l = 1
561         IF( nbondjl ==  1 .OR. nbondjl == 2 )   Nje0l = ipjl
562         nis0allp(jn) = Nis0l
563         nie0allp(jn) = Nie0l
564         njs0allp(jn) = Njs0l
565         nje0allp(jn) = Nje0l
566      END DO
567      !
568      ! Save processor layout in layout_prtctl.dat file
569      IF(lwp) THEN
570         CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
571         WRITE(inum,'(a)') 'nproc ipil ipjl Nis0l Njs0l Nie0l Nje0l nimpptl njmpptl ibonitl ibonjtl'
572         !
573         DO jn = 1, ijsplt
574            WRITE(inum,'(i5,6i6,4i8)') jn-1, jpiallp(jn),  jpjallp(jn), &
575               &                            nis0allp(jn), njs0allp(jn), &
576               &                            nie0allp(jn), nje0allp(jn), &
577               &                             nimpptl(jn),  njmpptl(jn), &
578               &                             ibonitl(jn),  ibonjtl(jn)
579         END DO
580         CLOSE(inum)   
581      END IF
582      !
583      !
584   END SUBROUTINE sub_dom
585
586   !!======================================================================
587END MODULE prtctl
Note: See TracBrowser for help on using the repository browser.