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 trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/prtctl.F90 @ 519

Last change on this file since 519 was 516, checked in by opalod, 18 years ago

nemo_v1_update_072 : CT : - lights modifications to ensure good control prints for the restartability & reproductibility tests

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