Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

prtctl.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago
All wrk_alloc removed
Property svn:keywords set to `Id`
File size: 24.4 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90 @ 7910

Download in other formats: