Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

inicmc.F @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago
Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).
File size: 24.1 KB

Line
1	SUBROUTINE inicmc
2	C****
3	C *****************************
4	C * OASIS ROUTINE - LEVEL C *
5	C * ------------- ------- *
6	C *****************************
7	C
8	C**** inicmc - Initialize coupled mode communication for coupler
9	C
10	C Purpose:
11	C -------
12	C Use either PIPE, CLIM, SIPC or GMEM library to start communication with
13	C the models being coupled. The PIPE library uses named pipes(fifo)
14	C while CLIM uses message passing library MPI-1 or MPI-2.
15	C The SIPC library uses shared memory segments based on system V IPC.
16	C The GMEM library uses the global memory concept of NEC machines.
17	C In cases SIPC, GMEM or PIPE, signal handling is implemented to trap
18	C oasis or child status changes.
19	C
20	C** Interface:
21	C ---------
22	C CALL inicmc
23	C
24	C Input:
25	C -----
26	C None
27	C
28	C Output:
29	C ------
30	C None
31	C
32	C Workspace:
33	C ---------
34	C None
35	C
36	C Externals:
37	C ---------
38	C (CLIM-PIPE-SIPC)_Init, (CLIM-PIPE-SIPC)_Define, (CLIM-PIPE-SIPC)_Stepi,
39	C CLIM_Start, chksgc
40	C
41	C Reference:
42	C ---------
43	C See OASIS manual (2000)
44	C
45	C History:
46	C -------
47	C Version Programmer Date Description
48	C ------- ---------- ---- -----------
49	C 1.0 L. Terray 94/01/01 created
50	C 2.0 L. Terray 95/09/01 modified : new structure
51	C 2.1 L. Terray 96/09/03 mofified : norm DOCTOR (loop
52	C index jp --> jl)
53	C 2.2 S. Valcke 97/06/20 added: introduction of SVIPC
54	C 2.2 L. Terray 97/09/20 general cleaning + call chksgc
55	C 2.3 S. Valcke 99/04/30 added: printing levels
56	C 2.3 L. Terray 99/09/15 added: GMEM branch
57	C 2.4 S. Valcke 2K/05/01 added: llmodel for CLIM/MPI2
58	C 2.5 S. Valcke 2K/09/04 Remove cmach
59	C 2.5 S. Valcke 2K/09/08 -Remove llmodel
60	C -Modified CALL to CLIM_Init
61	C 2.5 J. Latour 01/11/28 added : MPI1 use of mpirun
62	C
63	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64	C
65	C* ---------------- Include files and USE of modules---------------------------
66	C
67	USE mod_kinds_oasis
68	#if defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
69	USE mod_clim
70	USE mod_clim_def
71	USE mod_comclim
72	#endif
73	USE mod_parameter
74	USE mod_parallel
75	USE mod_string
76	USE mod_unitncdf
77	USE mod_experiment
78	USE mod_timestep
79	USE mod_unit
80	USE mod_hardware
81	USE mod_printing
82	USE mod_analysis
83	USE mod_label
84	USE mod_gauss
85	#if defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
86	#include <mpif.h>
87	#endif
88	C
89	C* ---------------------------- Local declarations ----------------------
90	C
91	INTEGER (kind=ip_intwp_p) il_dimid(2)
92	INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: info
93	INTEGER (kind=ip_intwp_p) iparal(3)
94	INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: il_sizold,
95	$ il_siznew, il_maxaux
96	CHARACTER*8 clpinp, clpout
97	CHARACTER*8 clwork, clstrg
98	CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: cl_auxaf, cl_auxbf
99	INTEGER (kind=ip_intwp_p) :: il_ibyt, il_bufsendsize,
100	$ il_bufsendsizebyt, il_varid, ii, io_size, integer_io_size
101	INTEGER (kind=ip_intwp_p) :: integer_byte_size
102	REAL(kind=ip_double_p) rl_testvar
103	c
104	C
105	C* ---------------------------- Poema verses ----------------------------
106	C
107	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
108	C
109	C* 1. Allocation and initializations
110	C ------------------------------
111	C
112	IF (nlogprt .GE. 1) THEN
113	WRITE (UNIT = nulou,FMT = *) ' '
114	WRITE (UNIT = nulou,FMT = *) ' '
115	WRITE (UNIT = nulou,FMT = *)
116	$ ' ROUTINE inicmc - Level C'
117	WRITE (UNIT = nulou,FMT = *)
118	$ ' ************ *****'
119	WRITE (UNIT = nulou,FMT = *) ' '
120	WRITE (UNIT = nulou,FMT = *) ' Process stuff initialization'
121	WRITE (UNIT = nulou,FMT = *) ' '
122	WRITE (UNIT = nulou,FMT = *) ' '
123	ENDIF
124	iparal(:)=0
125	C
126	C* Set up signal handling
127	C
128	CALL chksgc
129	C
130	C* Allocate and initialize error codes (only if all fields aren't exchanged
131	C directly)
132	C
133	IF (lg_oasis_field) THEN
134	ALLOCATE(info(ig_nfield))
135	CALL izero (info, ig_nfield)
136	ENDIF
137
138	C
139	c
140	C* PIPE initialization
141	c
142	#ifdef use_comm_PIPE
143	C
144	C* Open pipes between models to exchange checking data
145	C
146	infos = 0
147	CALL PIPE_Init (cjobnam, cmodnam, ig_nmodel, infos)
148	IF (infos .NE. 0) THEN
149	WRITE (UNIT = nulou,FMT = *)
150	$ ' WARNING : Problem with model pipe initialization'
151	WRITE (UNIT = nulou,FMT = *)
152	$ ' ======= Error code number = ',infos
153	CALL HALTE('STOP in inicmc')
154	ENDIF
155	C
156	C* SVIPC or GMEM initialization
157	C
158	#elif defined use_comm_SIPC \|\| defined use_comm_GMEM
159	C
160	C* Open shared memory pools used by models to exchange initial infos
161	C
162	infos = 0
163	CALL SIPC_Init (cjobnam, cmodnam, ig_nmodel, infos)
164	IF (infos .NE. 0) THEN
165	WRITE (UNIT = nulou,FMT = *)
166	$ 'WARNING : Problem with model shared memory pool initialization'
167	WRITE (UNIT = nulou,FMT = *)
168	$ ' ======= Error code number = ',infos
169	CALL HALTE('STOP in inicmc')
170	ENDIF
171	C
172	C* CLIM/MPI2 or MPI1 initialization
173	C
174	#elif defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
175	ione = 1
176	IF (cchan .EQ. 'MPI1') cmpiarg(:)=' '
177	CALL CLIM_Init_Oasis(cjobnam, 'Oasis',
178	$ ig_nmodel, cmodnam, nbcplproc, nbtotproc, cmpiarg,
179	$ iga_unitmod, nultr, infos)
180	IF (infos .NE. CLIM_Ok) THEN
181	WRITE (UNIT = nulou,FMT = *)
182	$ ' WARNING : Problem with MPI initialization '
183	WRITE (UNIT = nulou,FMT = *)
184	$ ' ======= CLIM error code number = ',infos
185	CALL HALTE('STOP in inicmc')
186	ENDIF
187	IF (.not. lg_oasis_field) THEN
188	WRITE (UNIT = nulou,FMT = *)
189	$ '===>>> All the fields are exchanged directly '
190	WRITE (UNIT = nulou,FMT = *)
191	$ ' Oasis calls only his MPI initialization and
192	$ sleeps until his MPI finalization'
193	ENDIF
194	#else
195	C
196	C* No message passing case
197	C
198	IF (cchan .EQ. 'NONE') THEN
199	IF (nlogprt .GE. 1) THEN
200	WRITE (UNIT = nulou, FMT = *)
201	$ ' NOTE : No message passing used in this run'
202	WRITE (UNIT = nulou,FMT = *)
203	$ ' ======= '
204	ENDIF
205	ELSE
206	CALL prcout('WARNING: your $CHANNEL option is wrong:',
207	$ cchan,1)
208	CALL HALTE('Wrong $CHANNEL option: STOP in inicmc')
209	ENDIF
210	C
211	#endif
212	C
213	C* Put here stuff moved from inipar_alloc because grids.nc (and therefore
214	C grid dimensions) is not available yet.
215	C* If grids.nc file exists, get grid dimensions there.
216	C
217	il_dimid(:)=0
218	il_auxbf=0
219	il_auxaf=0
220	allocate(cl_auxbf(ig_nfield))
221	cl_auxbf(:)=' '
222	allocate(cl_auxaf(ig_nfield))
223	cl_auxaf(:)=' '
224	ig_maxold_grid = 0
225	ig_maxnew_grid = 0
226	C
227	IF (lncdfgrd) CALL hdlerr
228	$ (NF_OPEN(cgrdnam//'.nc', NF_NOWRITE, nc_grdid), 'inicmc0')
229	C
230	DO 252 jf=1,ig_total_nfield
231	IF (ig_total_state(jf) .ne. ip_input) THEN
232	IF (lncdfgrd) THEN
233	C
234	C* Initial dimensions
235	clwork = cga_locatorbf(jf)
236	icount = ilenstr(clwork,jpeight)
237	clstrg = clwork(1:icount)//cglonsuf
238	CALL hdlerr
239	$ (NF_INQ_VARID(nc_grdid, clstrg, il_varid),
240	$ 'inicmc1')
241	CALL hdlerr
242	$ (NF_INQ_VARDIMID(nc_grdid,il_varid, il_dimid),
243	$ 'inicmc2')
244	CALL hdlerr
245	$ (NF_INQ_DIMLEN(nc_grdid, il_dimid(1), il_len),
246	$ 'inicmc3')
247	IF (lg_state(jf))
248	$ nlonbf(ig_number_field(jf)) = il_len
249	CALL hdlerr
250	$ (NF_INQ_DIMLEN(nc_grdid, il_dimid(2), il_len),
251	$ 'inicmc4')
252	IF (lg_state(jf))
253	$ nlatbf(ig_number_field(jf)) = il_len
254	C
255	C* Final dimensions
256	clwork = cga_locatoraf(jf)
257	icount = ilenstr(clwork,jpeight)
258	clstrg = clwork(1:icount)//cglonsuf
259	CALL hdlerr
260	$ (NF_INQ_VARID(nc_grdid, clstrg, il_varid),
261	$ 'inicmc5')
262	CALL hdlerr
263	$ (NF_INQ_VARDIMID(nc_grdid,il_varid, il_dimid),
264	$ 'inicmc6')
265	CALL hdlerr
266	$ (NF_INQ_DIMLEN(nc_grdid, il_dimid(1), il_len),
267	$ 'inicmc7')
268	IF (lg_state(jf))
269	$ nlonaf(ig_number_field(jf)) = il_len
270	CALL hdlerr
271	$ (NF_INQ_DIMLEN(nc_grdid, il_dimid(2), il_len),
272	$ 'inicmc8')
273	IF (lg_state(jf))
274	$ nlataf(ig_number_field(jf)) = il_len
275	C
276	C
277	ENDIF
278	ENDIF
279	C
280	C* Get the number of different grids used
281	C
282	IF (lg_state(jf)) then
283	IF (ig_number_field(jf).eq.1) THEN
284	cl_auxbf(1) = cficbf(1)
285	cl_auxaf(1) = cficaf(1)
286	ig_grid_nbrbf(1)=1
287	ig_grid_nbraf(1)=1
288	il_auxbf = 1
289	il_auxaf = 1
290	ig_maxold_grid = nlonbf(ig_number_field(jf)) *
291	$ nlatbf(ig_number_field(jf))
292	ig_maxnew_grid = nlonaf(ig_number_field(jf)) *
293	$ nlataf(ig_number_field(jf))
294	ELSEIF (ig_number_field(jf).gt.1) THEN
295	IF (ALL(cl_auxbf.ne.
296	$ cficbf(ig_number_field(jf)))) THEN
297	il_auxbf=il_auxbf + 1
298	cl_auxbf(il_auxbf)=cficbf(ig_number_field(jf))
299	ig_grid_nbrbf(ig_number_field(jf))=il_auxbf
300	ig_maxold_grid = ig_maxold_grid +
301	$ (nlonbf(ig_number_field(jf)) *
302	$ nlatbf(ig_number_field(jf)))
303	ELSE
304	DO ib = 1, il_auxbf
305	IF (cficbf(ig_number_field(jf)).eq.
306	$ cl_auxbf(ib))
307	$ ig_grid_nbrbf(ig_number_field(jf))= ib
308	ENDDO
309	ENDIF
310	IF (ALL(cl_auxaf.ne.
311	$ cficaf(ig_number_field(jf)))) THEN
312	il_auxaf=il_auxaf + 1
313	cl_auxaf(il_auxaf)=cficaf(ig_number_field(jf))
314	ig_grid_nbraf(ig_number_field(jf))=il_auxaf
315	ig_maxnew_grid = ig_maxnew_grid +
316	$ (nlonaf(ig_number_field(jf)) *
317	$ nlataf(ig_number_field(jf)))
318	ELSE
319	DO ib = 1, il_auxaf
320	IF (cficaf(ig_number_field(jf)).eq.
321	$ cl_auxaf(ib))
322	$ ig_grid_nbraf(ig_number_field(jf))= ib
323	ENDDO
324	ENDIF
325	ENDIF
326	ENDIF
327	252 END DO
328	C
329	C* Close netcdf file
330	IF (lncdfgrd) call hdlerr (NF_CLOSE(nc_grdid),'inicmc9')
331	C
332	IF (lg_oasis_field) THEN
333	ALLOCATE (il_sizold(ig_nfield))
334	ALLOCATE (il_siznew(ig_nfield))
335	il_sizold(:) = 0
336	il_siznew(:) = 0
337	DO jf=1,ig_nfield
338	il_sizold (jf) = nlonbf(jf)*nlatbf(jf)
339	il_siznew (jf) = nlonaf(jf)*nlataf(jf)
340	ig_maxgrd = imaxim(il_sizold, ig_nfield)
341	IF (imaxim(il_siznew, ig_nfield).gt.ig_maxgrd)
342	$ ig_maxgrd = imaxim(il_siznew, ig_nfield)
343	ENDDO
344	WRITE(nulou,*)
345	$ 'Maximum size of the different grids of indirect fields:',
346	$ ig_maxgrd
347	WRITE(nulou,*)' '
348	C
349	#if defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
350	ig_CLIMmax = 3 + CLIM_Clength + 2ig_total_nfield
351	$ (CLIM_Clength + 5 + CLIM_ParSize)
352	IF (ig_CLIMmax.lt.ig_maxgrd )
353	$ ig_CLIMmax = ig_maxgrd
354	ALLOCATE (pkwork(ig_CLIMmax), stat = il_ERR)
355	IF (il_ERR.NE.0) WRITE(nulou,*)
356	$ 'Error in pkwork allocation in inicmc '
357	pkwork(:)=0
358	#endif
359	C
360	C* Search sum of grids sizes of fields before and after interpolation
361	C
362	ig_maxold = isumi (il_sizold, ig_nfield)
363	ig_maxnew = isumi (il_siznew, ig_nfield)
364	WRITE(nulou,*)
365	$ 'Sum of grid sizes of fields before interpolation : ',
366	$ ig_maxold
367	WRITE(nulou,*)' '
368	WRITE(nulou,*)
369	$ 'Sum of grid sizes of fields after interpolation : ',
370	$ ig_maxnew
371	WRITE(nulou,*)' '
372	C
373	C* Search dimension of "nwork" array
374	C
375	ALLOCATE (il_maxaux(ig_nfield))
376	il_maxaux(:)=0
377	DO jf = 1,ig_nfield
378	il_redu = 0
379	IF (ntronca(jf) .NE. 0) THEN
380	IF (ntronca(jf) .EQ. 16) THEN
381	il_redu = nredu16
382	ELSE IF (ntronca(jf) .EQ. 24) THEN
383	il_redu = nredu24
384	ELSE IF (ntronca(jf) .EQ. 32) THEN
385	il_redu = nredu32
386	ELSE IF (ntronca(jf) .EQ. 48) THEN
387	il_redu = nredu48
388	ELSE IF (ntronca(jf) .EQ. 80) THEN
389	il_redu = nredu80
390	ELSE IF (ntronca(jf) .EQ. 160) THEN
391	il_redu = nredu160
392	ELSE
393	CALL prtout
394	$ ('WARNING!!! Oasis cannot treat this grid with
395	$ 2*NO latitude lines with NO = ',
396	$ ntronca(jf), 2)
397	ENDIF
398	ENDIF
399	IF (il_siznew(jf).ge.(il_redu+nlatbf(jf))) THEN
400	il_maxaux(jf) = il_siznew(jf)
401	ELSE
402	il_maxaux(jf) = il_redu+nlatbf(jf)
403	ENDIF
404	END DO
405	ig_nwork = imaxim (il_maxaux, ig_nfield)
406	C
407	C* Search dimension of "work" array
408	C
409	CALL izero(il_maxaux, ig_nfield)
410	DO jf = 1, ig_nfield
411	il_maxaux(jf) = nbnfld(jf)*il_siznew(jf)
412	IF (il_maxaux(jf).lt.(nbofld(jf)*il_sizold(jf)))
413	$ il_maxaux(jf) = nbofld(jf)*il_sizold(jf)
414	IF (il_maxaux(jf).lt.(nlonaf(jf)+nlataf(jf)
415	$ +2il_sizold(jf)+2il_siznew(jf)))
416	$ il_maxaux(jf) = nlonaf(jf) + nlataf(jf)
417	$ +2il_sizold(jf) + 2il_siznew(jf)
418	END DO
419	ig_work = imaxim(il_maxaux, ig_nfield)
420	IF (ig_work.lt.(3*ig_maxgrd))
421	$ ig_work = 3*ig_maxgrd
422	C
423	DEALLOCATE (il_maxaux)
424	DEALLOCATE (il_sizold)
425	DEALLOCATE (il_siznew)
426	ENDIF
427	DEALLOCATE (cl_auxbf)
428	DEALLOCATE (cl_auxaf)
429	#if defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
430	IF (lg_bsend) THEN
431	ii=0
432	rl_testvar = 0.0_ip_double_p
433	integer_byte_size = BIT_SIZE(ii)/8
434	INQUIRE (iolength=io_size) ii
435	integer_io_size = io_size
436	INQUIRE (iolength=io_size) rl_testvar
437	il_ibyt = io_size/integer_io_size*integer_byte_size
438	il_bufsendsize = 2ig_clim_nfield
439	$ (ig_maxgrd + MPI_BSEND_OVERHEAD/il_ibyt+1)
440	ALLOCATE (dg_bufsend(il_bufsendsize), stat = il_err)
441	IF (il_ERR.ne.0) WRITE(nulou,*)'Error in dg_bufsend
442	$ allocation in CLIM_Init_Oasis'
443	dg_bufsend(:)=0
444	il_bufsendsizebyt = il_bufsendsize * il_ibyt
445	C
446	C* Attach a buffer able to contain the maximum possible number of
447	C coupling fields with maximum possible
448	C size (ig_maxgrd) supposed to be declared as DOUBLE.
449	CALL MPI_Buffer_Attach(dg_bufsend, il_bufsendsizebyt,mpi_err)
450	WRITE(nulou,*)'Attached buffer of size=', il_bufsendsizebyt
451	ENDIF
452	#endif
453	C
454	C* END of stuff moved from inipar_alloc
455	C
456	C* Define ports and start the communication only if one field (at least)
457	C goes through Oasis
458	C
459	IF (lg_oasis_field) THEN
460	C
461	C* 2. Define ports or files for data exchange
462	C ---------------------------------------
463	C
464	C * PIPE case: define and open pipe files (FIFO)
465	C
466	#ifdef use_comm_PIPE
467	infos = 0
468	DO 250 jf = 1, ig_nfield
469	C
470	C * Define pipes actual names for each field
471	C
472	C - Reading
473	C
474	clpinp = cnaminp(jf)
475	C - Writing
476	clpout = cnamout(jf)
477	C
478	C * Create pipes
479	C
480	CALL PIPE_Define (cnaminp(jf), cnamout(jf),
481	$ clpinp, clpout , info(jf))
482	infos = infos + info(jf)
483	250 CONTINUE
484	IF (infos .NE. 0) THEN
485	WRITE (UNIT = nulou,FMT = *)
486	$ ' WARNING : Problem with field pipe initialization'
487	WRITE (UNIT = nulou,FMT = *)
488	$ ' ======= Error code number = ',infos
489	CALL HALTE('STOP in inicmc')
490	ENDIF
491	c ENDIF
492	C
493	C * SIPC case
494	C
495	#elif defined use_comm_SIPC \|\| defined use_comm_GMEM
496	infos = 0
497	DO 260 jf = 1, ig_nfield
498	C
499	C * Create two shared memory pools for each field
500	C
501	CALL SIPC_Define (jf, info(jf))
502	infos = infos + info(jf)
503	260 CONTINUE
504	IF (infos .NE. 0) THEN
505	WRITE (UNIT = nulou,FMT = *)
506	$ 'WARNING : Problem with field shared memory pool
507	$ initialization'
508	WRITE (UNIT = nulou,FMT = *)
509	$ ' ======= Error code number = ',infos
510	CALL HALTE('STOP in inicmc')
511	ELSE
512	C
513	C * If everything went alright, open one dummy file signaling
514	C that pools for exchange are opened
515	C
516	OPEN (UNIT = nudum, FILE = 'DUMMY_SIPC', STATUS
517	$ = 'NEW')
518	CLOSE (UNIT = nudum)
519	IF (nlogprt .GE. 1) THEN
520	WRITE (UNIT = nulou,FMT = *)
521	$ '* ===>>> : file DUMMY_SIPC created'
522	WRITE (UNIT = nulou,FMT = *)
523	$ ' ------ -----------------------'
524	ENDIF
525	ENDIF
526	C
527	C * CLIM case: define ports
528	C
529	#elif defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
530	C
531	C * Input ports for incoming fields
532	C
533	infos = CLIM_Ok
534	iparal(CLIM_Strategy) = CLIM_Serial
535	iparal(CLIM_Offset) = 0
536	DO 210 jf = 1, ig_nfield
537	iparal(CLIM_Length) = nlonbf(jf) * nlatbf(jf)
538	CALL CLIM_Define (ig_portin_id(jf),cnaminp(jf),CLIM_In,
539	$ CLIM_Real,iparal, info(jf))
540	infos = infos + info(jf)
541	210 CONTINUE
542	IF (infos .NE. CLIM_Ok) THEN
543	DO 220 jf = 1, ig_nfield
544	IF (info(jf) .NE. CLIM_Ok) THEN
545	WRITE (UNIT = nulou,FMT = *)
546	$ ' WARNING : Problem with port ', cnaminp(jf)
547	WRITE (UNIT = nulou,FMT = *)
548	$ ' ======= Error code number = ',info(jf)
549	ENDIF
550	220 CONTINUE
551	CALL HALTE ('STOP in inicmc')
552	ENDIF
553	C
554	C * Output ports for outgoing fields : serial decomposition
555	C
556	infos = CLIM_Ok
557	iparal(CLIM_Strategy) = CLIM_Serial
558	iparal(CLIM_Offset) = 0
559	DO 230 jf = 1, ig_nfield
560	iparal(CLIM_Length) = nlonaf(jf) * nlataf(jf)
561	CALL CLIM_Define (ig_portout_id(jf), cnamout(jf),
562	$ CLIM_Out, CLIM_Real, iparal, info(jf))
563	infos = infos + info(jf)
564	230 CONTINUE
565	IF (infos .NE. CLIM_Ok) THEN
566	DO 240 jf = 1, ig_nfield
567	IF (info(jf) .NE. CLIM_Ok) THEN
568	WRITE (UNIT = nulou,FMT = *)
569	$ ' WARNING : Problem with port ', cnamout(jf)
570	WRITE (UNIT = nulou,FMT = *)
571	$ ' ======= Error code number = ',info(jf)
572	ENDIF
573	240 CONTINUE
574	CALL HALTE ('STOP in inicmc')
575	ENDIF
576	#endif
577	C
578	C* 3. Start the communication and get timestep information
579	C ----------------------------------------------------
580	#ifdef use_comm_PIPE
581	infos = 0
582	DO 320 jm = 1, ig_nmodel
583	CALL PIPE_Stepi (cmodnam(jm), jm,
584	$ istep, ifcpl, idt, infos)
585	IF (infos .NE. 0) THEN
586	WRITE (UNIT = nulou,FMT = *)
587	$ ' WARNING : Problem in getting step info
588	$ from model ', cmodnam(jm)
589	WRITE (UNIT = nulou,FMT = *)
590	$ ' ======= Error code number = ',infos
591	CALL HALTE('STOP in inicmc')
592	ELSE
593	IF (nlogprt .GE. 1) THEN
594	WRITE (UNIT = nulou,FMT = *)
595	$ ' Got step information from model ',
596	$ cmodnam(jm)
597	ENDIF
598	ENDIF
599	mstep(jm) = istep
600	mfcpl(jm) = ifcpl
601	mdt(jm) = idt
602	320 CONTINUE
603	C
604	C * SIPC or GMEM Case
605	C
606	#elif defined use_comm_SIPC \|\| defined use_comm_GMEM
607	infos = 0
608	DO 330 jm = 1, ig_nmodel
609	CALL SIPC_Stepi (cmodnam(jm), jm,
610	$ istep, ifcpl, idt, infos)
611	IF (infos .NE. 0) THEN
612	CALL prcout
613	$ ('WARNING: Problem in getting step info from
614	$ model', cmodnam(jm), 1)
615	CALL prtout('Error code number = ',infos,1)
616	CALL HALTE('STOP in inicmc')
617	ELSE
618	CALL prcout
619	$ ('Got step information from model ',
620	$ cmodnam(jm), 1)
621	ENDIF
622	mstep(jm) = istep
623	mfcpl(jm) = ifcpl
624	mdt(jm) = idt
625	330 CONTINUE
626	c
627	C * CLIM CASE
628	C
629	#elif defined use_comm_MPI1 \|\| defined use_comm_MPI2 \|\| !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
630	c
631	CALL CLIM_Start (infos)
632	IF (infos .NE. CLIM_Ok) THEN
633	WRITE (UNIT = nulou,FMT = *)
634	$ ' WARNING : Problem in starting CLIM '
635	WRITE (UNIT = nulou,FMT = *)
636	$ ' ======= Error code number = ',infos
637	ENDIF
638	DO 310 jm = 1, ig_nmodel
639	CALL CLIM_Stepi (cmodnam(jm), infos)
640	IF (infos .lt. nbcplproc(jm)) THEN
641	WRITE (UNIT = nulou,FMT = *)
642	$ 'PROBLEM: Got initial informations only from',
643	$ infos
644	WRITE (UNIT = nulou,FMT = *)
645	$ 'processes of model', cmodnam(jm)
646	CALL halte ('STOP in inicmc.f')
647	ELSE
648	IF (nlogprt .GE. 1) THEN
649	WRITE (UNIT = nulou,FMT = *)
650	$ ' Got step informations from model ',
651	$ cmodnam(jm)
652	ENDIF
653	ENDIF
654	310 CONTINUE
655	#endif
656	ENDIF
657	C
658	C
659	C* 4. End of routine
660	C --------------
661	C
662	IF (lg_oasis_field) DEALLOCATE(info)
663	C
664	IF (nlogprt .GE. 1) THEN
665	WRITE (UNIT = nulou,FMT = *) ' '
666	WRITE (UNIT = nulou,FMT = *)
667	$ ' --------- End of routine inicmc ---------'
668	CALL FLUSH (nulou)
669	ENDIF
670	RETURN
671	END

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

Context Navigation

source: CPL/oasis3/trunk/src/mod/oasis3/src/inicmc.F @ 1677

Download in other formats: