Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

prtctl.F90 @ 951

Last change on this file since 951 was 790, checked in by gm, 16 years ago
dev_001_GM - complete theprevious comit with omitted routines
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 23.2 KB

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

Download in other formats: