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/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/prtctl.F90 @ 973

Last change on this file since 973 was 719, checked in by ctlod, 16 years ago

get back to the nemo_v2_3 version for trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.3 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 :: numid
15   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !:
16      nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain
17      nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain
18      nimpptl, njmpptl,   &  !: i-, j-indexes for each processor
19      nlcitl , nlcjtl ,   &  !: dimensions of every subdomain
20      ibonitl, ibonjtl
21
22   REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !:
23      t_ctll , s_ctll ,   &  !: previous trend values
24      u_ctll , v_ctll
25
26   INTEGER ::   ktime        !: time step
27
28   !! * Routine accessibility
29   PUBLIC prt_ctl         ! called by all subroutines
30   PUBLIC prt_ctl_info    ! called by all subroutines
31   PUBLIC prt_ctl_init    ! called by opa.F90
32   !!----------------------------------------------------------------------
33   !!   OPA 9.0 , LOCEAN-IPSL (2005)
34   !! $Header$
35   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
36   !!----------------------------------------------------------------------
37
38
39CONTAINS
40
41   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3)
42      !!----------------------------------------------------------------------
43      !!                     ***  ROUTINE prt_ctl  ***
44      !!
45      !! ** Purpose : - print sum control of 2D or 3D arrays over the same area
46      !!                in mono and mpp case. This way can be usefull when
47      !!                debugging a new parametrization in mono or mpp.
48      !!
49      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
50      !!                .true. in the ocean namelist:
51      !!              - to debug a MPI run .vs. a mono-processor one;
52      !!                the control print will be done over each sub-domain.
53      !!                The nictl[se] and njctl[se] parameters in the namelist must
54      !!                be set to zero and [ij]splt to the corresponding splitted
55      !!                domain in MPI along respectively i-, j- directions.
56      !!              - to debug a mono-processor run over the whole domain/a specific area;
57      !!                in the first case the nictl[se] and njctl[se] parameters must be set
58      !!                to zero else to the indices of the area to be controled. In both cases
59      !!                isplt and jsplt must be set to 1.
60      !!              - All arguments of the above calling sequence are optional so their
61      !!                name must be explicitly typed if used. For instance if the 3D
62      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine,
63      !!                it must looks like: CALL prt_ctl(tab3d_1=tn).
64      !!
65      !!                    tab2d_1 : first 2D array
66      !!                    tab3d_1 : first 3D array
67      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array
68      !!                    clinfo1 : information about the tab[23]d_1 array
69      !!                    tab2d_2 : second 2D array
70      !!                    tab3d_2 : second 3D array
71      !!                    mask2   : mask (3D) to apply to the tab[23]d_2 array
72      !!                    clinfo2 : information about the tab[23]d_2 array
73      !!                    ovlap   : overlap value
74      !!                    kdim    : k- direction for 3D arrays
75      !!                    clinfo3 : additional information
76      !!
77      !! History :
78      !!   9.0  !  05-07  (C. Talandier) original code
79      !!----------------------------------------------------------------------
80      !! * Arguments
81      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1
82      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1
83      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1
84      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo1
85      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_2
86      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2
87      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2
88      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo2
89      INTEGER                   , INTENT(in), OPTIONAL :: ovlap
90      INTEGER                   , INTENT(in), OPTIONAL :: kdim
91      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3
92
93      !! * Local declarations
94      INTEGER :: overlap, jn, sind, eind, kdir,j_id
95      CHARACTER (len=15) :: cl2
96      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
97      REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2
98      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2
99      !!----------------------------------------------------------------------
100
101      ! Arrays, scalars initialization
102      overlap   = 0
103      kdir      = jpkm1
104      cl2       = ''
105      zsum1     = 0.e0
106      zsum2     = 0.e0
107      zvctl1    = 0.e0
108      zvctl2    = 0.e0
109      ztab2d_1(:,:)   = 0.e0
110      ztab2d_2(:,:)   = 0.e0
111      ztab3d_1(:,:,:) = 0.e0
112      ztab3d_2(:,:,:) = 0.e0
113      zmask1  (:,:,:) = 1.e0
114      zmask2  (:,:,:) = 1.e0
115
116      ! Control of optional arguments
117      IF( PRESENT(clinfo2) )  cl2            = clinfo2
118      IF( PRESENT(ovlap)   )  overlap        = ovlap
119      IF( PRESENT(kdim)    )  kdir           = kdim
120      IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:)
121      IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:)
122      IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,:)= tab3d_1(:,:,:)
123      IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,:)= tab3d_2(:,:,:)
124      IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:)
125      IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:)
126
127      IF( lk_mpp )   THEN
128         ! processor number
129         sind = narea
130         eind = narea
131      ELSE
132         ! processors total number
133         sind = 1
134         eind = ijsplt
135      ENDIF
136
137      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
138      DO jn = sind, eind
139         ! Set logical unit
140         j_id = numid(jn - narea + 1)
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(j_id,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(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
202         ELSE
203            WRITE(j_id,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 :: jn, sind, eind, iltime, j_id
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         ! Set logical unit
261         j_id = numid(jn - narea + 1)
262
263         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
264            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2
265         ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
266            WRITE(j_id,*)clinfo1, ivar1, clinfo2
267         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
268            WRITE(j_id,*)clinfo1, ivar1, ivar2
269         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
270            WRITE(j_id,*)clinfo1, ivar1
271         ELSE
272            WRITE(j_id,*)clinfo1
273         ENDIF
274
275      ENDDO
276
277
278      END SUBROUTINE prt_ctl_info
279
280   SUBROUTINE prt_ctl_init
281      !!----------------------------------------------------------------------
282      !!                     ***  ROUTINE prt_ctl_init  ***
283      !!
284      !! ** Purpose :   open ASCII files & compute indices
285      !!
286      !! History :
287      !!   9.0  !  05-07  (C. Talandier) original code
288      !!----------------------------------------------------------------------
289      !! * Local declarations
290      INTEGER ::   jn, sind, eind, j_id
291      CHARACTER (len=28) :: clfile_out
292      CHARACTER (len=23) :: clb_name
293      CHARACTER (len=19) :: cl_run
294      !!----------------------------------------------------------------------
295
296      ! Allocate arrays
297      ALLOCATE(nlditl (ijsplt))
298      ALLOCATE(nldjtl (ijsplt))
299      ALLOCATE(nleitl (ijsplt))
300      ALLOCATE(nlejtl (ijsplt))
301      ALLOCATE(nimpptl(ijsplt))
302      ALLOCATE(njmpptl(ijsplt))
303      ALLOCATE(nlcitl (ijsplt))
304      ALLOCATE(nlcjtl (ijsplt))
305      ALLOCATE(t_ctll (ijsplt))
306      ALLOCATE(s_ctll (ijsplt))
307      ALLOCATE(u_ctll (ijsplt))
308      ALLOCATE(v_ctll (ijsplt))
309      ALLOCATE(ibonitl(ijsplt))
310      ALLOCATE(ibonjtl(ijsplt))
311
312      ! Initialization
313      t_ctll(:)=0.e0
314      s_ctll(:)=0.e0
315      u_ctll(:)=0.e0
316      v_ctll(:)=0.e0
317      ktime = 1
318
319      IF( lk_mpp ) THEN
320         sind = narea
321         eind = narea
322         clb_name = "('mpp.output_',I4.4)"
323         cl_run = 'MULTI processor run'
324         ! use indices for each area computed by mpp_init subroutine
325         nlditl(:) = nldit(:) 
326         nleitl(:) = nleit(:) 
327         nldjtl(:) = nldjt(:) 
328         nlejtl(:) = nlejt(:) 
329         !
330         nimpptl(:) = nimppt(:)
331         njmpptl(:) = njmppt(:)
332         !
333         nlcitl(:) = nlcit(:)
334         nlcjtl(:) = nlcjt(:)
335         !
336         ibonitl(:) = ibonit(:)
337         ibonjtl(:) = ibonjt(:)
338      ELSE
339         sind = 1
340         eind = ijsplt
341         clb_name = "('mono.output_',I4.4)"
342         cl_run = 'MONO processor run '
343         ! compute indices for each area as done in mpp_init subroutine
344         CALL sub_dom
345      ENDIF
346
347      ALLOCATE(numid(eind-sind+1))
348
349      DO jn = sind, eind
350         WRITE(clfile_out,FMT=clb_name) jn-1
351         CALL ctlopn( numid(jn -narea + 1), clfile_out, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
352            &         1, numout, .FALSE., 1 )
353         j_id = numid(jn -narea + 1)
354         WRITE(j_id,*)
355         WRITE(j_id,*) '                 L O D Y C - I P S L'
356         WRITE(j_id,*) '                     O P A model'
357         WRITE(j_id,*) '            Ocean General Circulation Model'
358         WRITE(j_id,*) '               version OPA 9.0  (2005) '
359         WRITE(j_id,*)
360         WRITE(j_id,*) '                   PROC number: ', jn
361         WRITE(j_id,*)
362         WRITE(j_id,FMT="(19x,a20)")cl_run
363
364         ! Print the SUM control indices
365         IF( .NOT. lsp_area )   THEN
366            nictls = nimpptl(jn) + nlditl(jn) - 1
367            nictle = nimpptl(jn) + nleitl(jn) - 1
368            njctls = njmpptl(jn) + nldjtl(jn) - 1
369            njctle = njmpptl(jn) + nlejtl(jn) - 1
370         ENDIF
371         WRITE(j_id,*) 
372         WRITE(j_id,*) 'prt_ctl :  Sum control indices'
373         WRITE(j_id,*) '~~~~~~~'
374         WRITE(j_id,*)
375         WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              '
376         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
377         WRITE(j_id,9001)'                  |                                       |'
378         WRITE(j_id,9001)'                  |                                       |'
379         WRITE(j_id,9001)'                  |                                       |'
380         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
381         WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn)
382         WRITE(j_id,9001)'                  |                                       |'
383         WRITE(j_id,9001)'                  |                                       |'
384         WRITE(j_id,9001)'                  |                                       |'
385         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------'
386         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              '
387         WRITE(j_id,*)
388         WRITE(j_id,*)
389
3909000     FORMAT(a41,i4.4,a14)
3919001     FORMAT(a59)
3929002     FORMAT(a20,i4.4,a36,i3.3)
3939003     FORMAT(a20,i4.4,a17,i4.4)
3949004     FORMAT(a11,i4.4,a26,i4.4,a14)
395      ENDDO
396
397   END SUBROUTINE prt_ctl_init
398
399
400   SUBROUTINE sub_dom
401      !!----------------------------------------------------------------------
402      !!                  ***  ROUTINE sub_dom  ***
403      !!                   
404      !! ** Purpose :   Lay out the global domain over processors.
405      !!                CAUTION:
406      !!                This part has been extracted from the mpp_init
407      !!                subroutine and names of variables/arrays have been
408      !!                slightly changed to avoid confusion but the computation
409      !!                is exactly the same. Any modification about indices of
410      !!                each sub-domain in the mppini.F90 module should be reported
411      !!                here.
412      !!
413      !! ** Method  :   Global domain is distributed in smaller local domains.
414      !!                Periodic condition is a function of the local domain position
415      !!                (global boundary or neighbouring domain) and of the global
416      !!                periodic
417      !!                Type :         jperio global periodic condition
418      !!                               nperio local  periodic condition
419      !!
420      !! ** Action  : - set domain parameters
421      !!                    nimpp     : longitudinal index
422      !!                    njmpp     : latitudinal  index
423      !!                    nperio    : lateral condition type
424      !!                    narea     : number for local area
425      !!                    nlcil      : first dimension
426      !!                    nlcjl      : second dimension
427      !!                    nbondil    : mark for "east-west local boundary"
428      !!                    nbondjl    : mark for "north-south local boundary"
429      !!
430      !! History :
431      !!        !  94-11  (M. Guyon)  Original code
432      !!        !  95-04  (J. Escobar, M. Imbard)
433      !!        !  98-02  (M. Guyon)  FETI method
434      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
435      !!   8.5  !  02-08  (G. Madec)  F90 : free form
436      !!----------------------------------------------------------------------
437      !! * Local variables
438      INTEGER ::   ji, jj, jn               ! dummy loop indices
439      INTEGER ::   &
440         ii, ij,                         &  ! temporary integers
441         irestil, irestjl,               &  !    "          "
442         ijpi  , ijpj, nlcil,            &  ! temporary logical unit
443         nlcjl , nbondil, nbondjl,       &
444         nrecil, nrecjl, nldil, nleil, nldjl, nlejl
445
446      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   &
447         iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace
448      REAL(wp) ::   zidom, zjdom            ! temporary scalars
449      !!----------------------------------------------------------------------
450
451      !  1. Dimension arrays for subdomains
452      ! -----------------------------------
453      !  Computation of local domain sizes ilcitl() ilcjtl()
454      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
455      !  The subdomains are squares leeser than or equal to the global
456      !  dimensions divided by the number of processors minus the overlap
457      !  array (cf. par_oce.F90).
458
459      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
460      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
461
462      ALLOCATE(ilcitl (isplt,jsplt))
463      ALLOCATE(ilcjtl (isplt,jsplt))
464
465      nrecil  = 2 * jpreci
466      nrecjl  = 2 * jprecj
467      irestil = MOD( jpiglo - nrecil , isplt )
468      irestjl = MOD( jpjglo - nrecjl , jsplt )
469
470      IF(  irestil == 0 )   irestil = isplt
471      DO jj = 1, jsplt
472         DO ji = 1, irestil
473            ilcitl(ji,jj) = ijpi
474         END DO
475         DO ji = irestil+1, isplt
476            ilcitl(ji,jj) = ijpi -1
477         END DO
478      END DO
479     
480      IF( irestjl == 0 )   irestjl = jsplt
481      DO ji = 1, isplt
482         DO jj = 1, irestjl
483            ilcjtl(ji,jj) = ijpj
484         END DO
485         DO jj = irestjl+1, jsplt
486            ilcjtl(ji,jj) = ijpj -1
487         END DO
488      END DO
489     
490      zidom = nrecil
491      DO ji = 1, isplt
492         zidom = zidom + ilcitl(ji,1) - nrecil
493      END DO
494      IF(lwp) WRITE(numout,*)
495      IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo
496     
497      zjdom = nrecjl
498      DO jj = 1, jsplt
499         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
500      END DO
501      IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo
502      IF(lwp) WRITE(numout,*)
503     
504
505      !  2. Index arrays for subdomains
506      ! -------------------------------
507
508      ALLOCATE(iimpptl(isplt,jsplt))
509      ALLOCATE(ijmpptl(isplt,jsplt))
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) + ilcitl(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)+ilcjtl(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         nlcitl (jn) = ilcitl (ii,ij)     
539         nlcil       = nlcitl (jn)     
540         nlcjtl (jn) = ilcjtl (ii,ij)     
541         nlcjl       = nlcjtl (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         nldil =  1   + jpreci
555         nleil = nlcil - jpreci
556         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
557         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
558         nldjl =  1   + jprecj
559         nlejl = nlcjl - jprecj
560         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
561         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
562         nlditl(jn) = nldil
563         nleitl(jn) = nleil
564         nldjtl(jn) = nldjl
565         nlejtl(jn) = nlejl
566      END DO
567
568      DEALLOCATE(iimpptl)
569      DEALLOCATE(ijmpptl)
570      DEALLOCATE(ilcitl)
571      DEALLOCATE(ilcjtl)
572
573   END SUBROUTINE sub_dom
574
575END MODULE prtctl
Note: See TracBrowser for help on using the repository browser.