Context Navigation

oasis.F @ 467

Last change on this file since 467 was 2, checked in by lmdz, 25 years ago
Initial revision
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 35.5 KB

Line
1	SUBROUTINE inicma(kastp,kexch,kstep)
2	IMPLICIT none
3	c
4	INTEGER kastp, kexch, kstep
5	c
6	INTEGER ime
7	PARAMETER (ime = 1)
8	c
9	C****
10	C *****************
11	C * OASIS ROUTINE *
12	C * ------------- *
13	C *****************
14	C
15	C**** INICMA - Initialize coupled mode communication for atmosphere
16	C
17	C Purpose:
18	C -------
19	C Exchange process identifiers and timestep information
20	C between AGCM, OGCM and COUPLER.
21	C
22	C Input:
23	C -----
24	C KASTP : total number of timesteps in atmospheric model
25	C KEXCH : frequency of exchange (in time steps)
26	C KSTEP : timestep value (in seconds)
27	C
28	C Method:
29	C ------
30	C Use named pipes(FIFO) to exchange process identifiers
31	C between the programs
32	C
33	C Externals:
34	C ---------
35	C GETPID, MKNOD
36	C
37	C Reference:
38	C ---------
39	C See Epicoa 0803 (1992)
40	C
41	C Author:
42	C -------
43	C Laurent Terray 92-09-01
44	C
45	C -----------------------------------------------------------
46	C
47	INTEGER imess(4)
48	INTEGER getpid, mknod ! system functions
49	CHARACTER*80 clcmd
50	CHARACTER*8 pipnom, fldnom
51	INTEGER ierror
52	C
53	#include "dimensions.h"
54	#include "dimphy.h"
55	#include "oasis.h"
56	#include "clim.h"
57	c
58	INTEGER iparal(3)
59	INTEGER istep, ifcpl, idt, info, imxtag
60	c
61	INTEGER mode, iret, isize
62	C
63	INTEGER nuout
64	PARAMETER (nuout = 6)
65	C -----------------------------------------------------------
66	C
67	C* 1. Initializations
68	C ---------------
69	C
70	WRITE(nuout,*) ' '
71	WRITE(nuout,*) ' '
72	WRITE(nuout,*) ' ROUTINE INICMA'
73	WRITE(nuout,) ' *************'
74	WRITE(nuout,*) ' '
75	WRITE(nuout,*) ' '
76	c
77	IF (cchain.EQ."PIPE") THEN
78	c
79	WRITE(nuout,*) " "
80	WRITE(nuout,*) "Making pipes for fields to receive from CPL"
81	WRITE(nuout,*) " "
82	c
83	c zxli(le17fev97): je ne comprends pas pourquoi il faut
84	c avoir 2 noms pour un seul pipe
85	c
86	pipnom = "SISUTESU"
87	fldnom = "Sisutesu"
88	#ifdef CRAY
89	clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
90	CALL assign(clcmd, ierror)
91	ierror = mknod (pipnom, 4480, 0)
92	WRITE(nuout,'(a80)') clcmd
93	#else
94	clcmd = "CALL makepipe("//pipnom//",...,...)"
95	mode = o'010600'
96	iret = 0
97	CALL makepipe(pipnom, mode, iret)
98	WRITE(nuout,'(a80)') clcmd
99	#endif
100	c
101	pipnom = "SIALBEDO"
102	fldnom = "Sialbedo"
103	#ifdef CRAY
104	clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
105	CALL assign(clcmd, ierror)
106	ierror = mknod (pipnom, 4480, 0)
107	WRITE(nuout,'(a80)') clcmd
108	#else
109	clcmd = "CALL makepipe("//pipnom//",...,...)"
110	mode = o'010600'
111	iret = 0
112	CALL makepipe(pipnom, mode, iret)
113	WRITE(nuout,'(a80)') clcmd
114	#endif
115	c
116	pipnom = "SIICECOV"
117	fldnom = "Siicecov"
118	#ifdef CRAY
119	clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
120	CALL assign(clcmd, ierror)
121	ierror = mknod (pipnom, 4480, 0)
122	WRITE(nuout,'(a80)') clcmd
123	#else
124	clcmd = "CALL makepipe("//pipnom//",...,...)"
125	mode = o'010600'
126	iret = 0
127	CALL makepipe(pipnom, mode, iret)
128	WRITE(nuout,'(a80)') clcmd
129	#endif
130	c
131	pipnom = "SIICEALB"
132	fldnom = "Siicealb"
133	#ifdef CRAY
134	clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
135	CALL assign(clcmd, ierror)
136	ierror = mknod (pipnom, 4480, 0)
137	WRITE(nuout,'(a80)') clcmd
138	#else
139	clcmd = "CALL makepipe("//pipnom//",...,...)"
140	mode = o'010600'
141	iret = 0
142	CALL makepipe(pipnom, mode, iret)
143	WRITE(nuout,'(a80)') clcmd
144	#endif
145	c
146	WRITE(nuout,*) " "
147	WRITE(nuout,*) "Making pipes for fields to send to CPL"
148	WRITE(nuout,*) " "
149	c
150	pipnom = "CONSFTOT"
151	fldnom = "Consftot"
152	#ifdef CRAY
153	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
154	CALL assign(clcmd, ierror)
155	ierror = mknod (pipnom, 4480, 0)
156	WRITE(nuout,'(a80)') clcmd
157	#else
158	clcmd = "CALL makepipe("//pipnom//",...,...)"
159	mode = o'010600'
160	iret = 0
161	CALL makepipe(pipnom, mode, iret)
162	WRITE(nuout,'(a80)') clcmd
163	#endif
164	c
165	pipnom = "COSSTSST"
166	fldnom = "Cosstsst"
167	#ifdef CRAY
168	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
169	CALL assign(clcmd, ierror)
170	ierror = mknod (pipnom, 4480, 0)
171	WRITE(nuout,'(a80)') clcmd
172	#else
173	clcmd = "CALL makepipe("//pipnom//",...,...)"
174	mode = o'010600'
175	iret = 0
176	CALL makepipe(pipnom, mode, iret)
177	WRITE(nuout,'(a80)') clcmd
178	#endif
179	c
180	pipnom = "CODFLXDT"
181	fldnom = "Codflxdt"
182	#ifdef CRAY
183	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
184	CALL assign(clcmd, ierror)
185	ierror = mknod (pipnom, 4480, 0)
186	WRITE(nuout,'(a80)') clcmd
187	#else
188	clcmd = "CALL makepipe("//pipnom//",...,...)"
189	mode = o'010600'
190	iret = 0
191	CALL makepipe(pipnom, mode, iret)
192	WRITE(nuout,'(a80)') clcmd
193	#endif
194	c
195	pipnom = "COSHFTOT"
196	fldnom = "Coshftot"
197	#ifdef CRAY
198	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
199	CALL assign(clcmd, ierror)
200	ierror = mknod (pipnom, 4480, 0)
201	WRITE(nuout,'(a80)') clcmd
202	#else
203	clcmd = "CALL makepipe("//pipnom//",...,...)"
204	mode = o'010600'
205	iret = 0
206	CALL makepipe(pipnom, mode, iret)
207	WRITE(nuout,'(a80)') clcmd
208	#endif
209	c
210	pipnom = "COALBSUR"
211	fldnom = "Coalbsur"
212	#ifdef CRAY
213	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
214	CALL assign(clcmd, ierror)
215	ierror = mknod (pipnom, 4480, 0)
216	WRITE(nuout,'(a80)') clcmd
217	#else
218	clcmd = "CALL makepipe("//pipnom//",...,...)"
219	mode = o'010600'
220	iret = 0
221	CALL makepipe(pipnom, mode, iret)
222	WRITE(nuout,'(a80)') clcmd
223	#endif
224	c
225	pipnom = "COTOSPSU"
226	fldnom = "Cotospsu"
227	#ifdef CRAY
228	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
229	CALL assign(clcmd, ierror)
230	ierror = mknod (pipnom, 4480, 0)
231	WRITE(nuout,'(a80)') clcmd
232	#else
233	clcmd = "CALL makepipe("//pipnom//",...,...)"
234	mode = o'010600'
235	iret = 0
236	CALL makepipe(pipnom, mode, iret)
237	WRITE(nuout,'(a80)') clcmd
238	#endif
239	c
240	pipnom = "COTOLPSU"
241	fldnom = "Cotolpsu"
242	#ifdef CRAY
243	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
244	CALL assign(clcmd, ierror)
245	ierror = mknod (pipnom, 4480, 0)
246	WRITE(nuout,'(a80)') clcmd
247	#else
248	clcmd = "CALL makepipe("//pipnom//",...,...)"
249	mode = o'010600'
250	iret = 0
251	CALL makepipe(pipnom, mode, iret)
252	WRITE(nuout,'(a80)') clcmd
253	#endif
254	c
255	pipnom = "COTFSHSU"
256	fldnom = "Cotfshsu"
257	#ifdef CRAY
258	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
259	CALL assign(clcmd, ierror)
260	ierror = mknod (pipnom, 4480, 0)
261	WRITE(nuout,'(a80)') clcmd
262	#else
263	clcmd = "CALL makepipe("//pipnom//",...,...)"
264	mode = o'010600'
265	iret = 0
266	CALL makepipe(pipnom, mode, iret)
267	WRITE(nuout,'(a80)') clcmd
268	#endif
269	c
270	pipnom = "CORUNCOA"
271	fldnom = "Coruncoa"
272	#ifdef CRAY
273	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
274	CALL assign(clcmd, ierror)
275	ierror = mknod (pipnom, 4480, 0)
276	WRITE(nuout,'(a80)') clcmd
277	#else
278	clcmd = "CALL makepipe("//pipnom//",...,...)"
279	mode = o'010600'
280	iret = 0
281	CALL makepipe(pipnom, mode, iret)
282	WRITE(nuout,'(a80)') clcmd
283	#endif
284	c
285	pipnom = "CORIVFLU"
286	fldnom = "Corivflu"
287	#ifdef CRAY
288	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
289	CALL assign(clcmd, ierror)
290	ierror = mknod (pipnom, 4480, 0)
291	WRITE(nuout,'(a80)') clcmd
292	#else
293	clcmd = "CALL makepipe("//pipnom//",...,...)"
294	mode = o'010600'
295	iret = 0
296	CALL makepipe(pipnom, mode, iret)
297	WRITE(nuout,'(a80)') clcmd
298	#endif
299	c
300	pipnom = "COZOTAUX"
301	fldnom = "Cozotaux"
302	#ifdef CRAY
303	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
304	CALL assign(clcmd, ierror)
305	ierror = mknod (pipnom, 4480, 0)
306	WRITE(nuout,'(a80)') clcmd
307	#else
308	clcmd = "CALL makepipe("//pipnom//",...,...)"
309	mode = o'010600'
310	iret = 0
311	CALL makepipe(pipnom, mode, iret)
312	WRITE(nuout,'(a80)') clcmd
313	#endif
314	c
315	pipnom = "COMETAUY"
316	fldnom = "Cometauy"
317	#ifdef CRAY
318	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
319	CALL assign(clcmd, ierror)
320	ierror = mknod (pipnom, 4480, 0)
321	WRITE(nuout,'(a80)') clcmd
322	#else
323	clcmd = "CALL makepipe("//pipnom//",...,...)"
324	mode = o'010600'
325	iret = 0
326	CALL makepipe(pipnom, mode, iret)
327	WRITE(nuout,'(a80)') clcmd
328	#endif
329	c
330	pipnom = "COZOTAU2"
331	fldnom = "Cozotau2"
332	#ifdef CRAY
333	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
334	CALL assign(clcmd, ierror)
335	ierror = mknod (pipnom, 4480, 0)
336	WRITE(nuout,'(a80)') clcmd
337	#else
338	clcmd = "CALL makepipe("//pipnom//",...,...)"
339	mode = o'010600'
340	iret = 0
341	CALL makepipe(pipnom, mode, iret)
342	WRITE(nuout,'(a80)') clcmd
343	#endif
344	c
345	pipnom = "COMETAU2"
346	fldnom = "Cometau2"
347	#ifdef CRAY
348	clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
349	CALL assign(clcmd, ierror)
350	ierror = mknod (pipnom, 4480, 0)
351	WRITE(nuout,'(a80)') clcmd
352	#else
353	clcmd = "CALL makepipe("//pipnom//",...,...)"
354	mode = o'010600'
355	iret = 0
356	CALL makepipe(pipnom, mode, iret)
357	WRITE(nuout,'(a80)') clcmd
358	#endif
359	c
360	WRITE(nuout,*) " "
361	WRITE(nuout,*) "All pipes have been made"
362	WRITE(nuout,*) " "
363	CALL flush(nuout)
364	c
365	WRITE(nuout,*) " "
366	WRITE(nuout,*) "Communication test between ATM and CPL"
367	WRITE(nuout,*) " "
368	c
369	WRITE (pipnom,'(a6,i2.2)') "Preadm", ime
370	#ifdef CRAY
371	clcmd = "assign -s u f:"//pipnom
372	CALL assign(clcmd, ierror)
373	ierror = mknod (pipnom, 4480, 0)
374	#else
375	clcmd = "CALL makepipe("//pipnom//",...,...)"
376	mode = o'010600'
377	iret = 0
378	CALL makepipe(pipnom, mode, iret)
379	#endif
380	WRITE(nuout,'(a80)') clcmd
381	imess(1) = kastp
382	imess(2) = kexch
383	imess(3) = kstep
384	imess(4) = getpid()
385	#ifdef CRAY
386	WRITE (pipnom) imess ! send message to pipe
387	#else
388	iret=0
389	isize=4
390	CALL pipwrite(pipnom, imess, isize, iret)
391	#endif
392	WRITE(nuout,*) "Msg sent to pipe "//pipnom
393	CALL flush(nuout)
394	c
395	WRITE (pipnom,'(a6,i2.2)') "Pwritm", ime
396	#ifdef CRAY
397	clcmd = "assign -s unblocked f:"//pipnom
398	CALL assign(clcmd, ierror)
399	ierror = mknod (pipnom, 4480, 0)
400	#else
401	clcmd = "CALL makepipe("//pipnom//",...,...)"
402	mode = o'010600'
403	iret = 0
404	CALL makepipe(pipnom, mode, iret)
405	#endif
406	WRITE(nuout,'(a80)') clcmd
407	c
408	WRITE(nuout,*) "Waiting for the pipe "//pipnom
409	CALL flush(nuout)
410	#ifdef CRAY
411	READ (pipnom) imess ! read message from pipe
412	#else
413	isize=1
414	iret =0
415	CALL pipread(pipnom,imess,isize,iret)
416	#endif
417	c
418	WRITE(nuout,*) " "
419	WRITE(nuout,*) "Communication test between ATM and CPL is OK"
420	WRITE(nuout,*) " total simulation time in oasis = ", imess(1)
421	WRITE(nuout,*) " total number of iterations is = ", imess(2)
422	WRITE(nuout,*) " value of oasis timestep is = ", imess(3)
423	WRITE(nuout,*) " process id for oasis is = ", imess(4)
424	WRITE(nuout,*) " "
425	CALL flush(nuout)
426	c
427	ELSE ! cchain.EQ."CLIM"
428	c
429	CALL CLIM_Init ( 'CLI', 'lmd.xx', 3, 7,
430	* kastp, kexch, kstep,
431	* 5, 1200, 300, info )
432	IF (info.EQ.CLIM_Ok) THEN
433	WRITE(nuout,*) "inicma: CLIM_Init OK"
434	ELSE
435	WRITE(nuout,*) "inicma: CLIM_Init erreur:", info
436	CALL ABORT("STOP in inicma")
437	ENDIF
438	c
439	iparal ( CLIM_Strategy ) = CLIM_Serial
440	iparal ( CLIM_Length ) = iim*(jjm+1)
441	iparal ( CLIM_Offset ) = 0
442	c
443	CALL CLIM_Define ('SISUTESU', CLIM_In , CLIM_Double, iparal, info)
444	CALL CLIM_Define ('SIALBEDO', CLIM_In , CLIM_Double, iparal, info)
445	CALL CLIM_Define ('SIICECOV', CLIM_In , CLIM_Double, iparal, info)
446	CALL CLIM_Define ('SIICEALB', CLIM_In , CLIM_Double, iparal, info)
447	c
448	CALL CLIM_Define ('CONSFTOT', CLIM_Out , CLIM_Double, iparal,info)
449	CALL CLIM_Define ('COSSTSST', CLIM_Out , CLIM_Double, iparal,info)
450	CALL CLIM_Define ('CODFLXDT', CLIM_Out , CLIM_Double, iparal,info)
451	CALL CLIM_Define ('COSHFTOT', CLIM_Out , CLIM_Double, iparal,info)
452	CALL CLIM_Define ('COALBSUR', CLIM_Out , CLIM_Double, iparal,info)
453	CALL CLIM_Define ('COTOSPSU', CLIM_Out , CLIM_Double, iparal,info)
454	CALL CLIM_Define ('COTOLPSU', CLIM_Out , CLIM_Double, iparal,info)
455	CALL CLIM_Define ('COTFSHSU', CLIM_Out , CLIM_Double, iparal,info)
456	CALL CLIM_Define ('CORUNCOA', CLIM_Out , CLIM_Double, iparal,info)
457	CALL CLIM_Define ('CORIVFLU', CLIM_Out , CLIM_Double, iparal,info)
458	CALL CLIM_Define ('COZOTAUX', CLIM_Out , CLIM_Double, iparal,info)
459	CALL CLIM_Define ('COMETAUY', CLIM_Out , CLIM_Double, iparal,info)
460	CALL CLIM_Define ('COZOTAU2', CLIM_Out , CLIM_Double, iparal,info)
461	CALL CLIM_Define ('COMETAU2', CLIM_Out , CLIM_Double, iparal,info)
462	WRITE(nuout,*) 'inicma : CLIM_Define ok '
463	c
464	CALL CLIM_Start ( imxtag, info )
465	IF (info.NE.CLIM_Ok) THEN
466	WRITE (nuout,*) "inicma: CLIM_Start pb. ", info
467	CALL ABORT("STOP in inicma")
468	ELSE
469	WRITE (nuout,*) "inicma: CLIM_Start OK"
470	ENDIF
471	c
472	CALL CLIM_Stepi ("oasis", istep, ifcpl, idt, info)
473	IF (info .NE. CLIM_Ok) THEN
474	WRITE (nuout,*) "inicma: CLIM_Stepi pb. ", info
475	CALL ABORT("STOP in inicma")
476	ELSE
477	WRITE (nuout,*) "inicma: CLIM_Stepi OK"
478	WRITE (nuout,*) " number of tstep in oasis ", istep
479	WRITE (nuout,*) " exchange frequency in oasis ", ifcpl
480	WRITE (nuout,*) " length of tstep in oasis ", idt
481	ENDIF
482	c
483	ENDIF
484	c
485	RETURN
486	END
487	SUBROUTINE fromcpl(jour, imjm, sst, sic, alb_sst, alb_sic)
488	IMPLICIT none
489	c
490	c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
491	c provided by the coupler. Of course, it waits until it receives
492	c the signal from the corresponding pipes in the case of utilizing
493	c the pipe technique.
494	c
495	INTEGER imjm, jour
496	REAL sst(imjm) ! sea surface temperature
497	REAL alb_sst(imjm) ! open sea albedo
498	REAL sic(imjm) ! sea ice cover
499	REAL alb_sic(imjm) ! sea ice albedo
500	c
501	INTEGER nuout ! listing output unit
502	PARAMETER (nuout=6)
503	c
504	INTEGER nuread, ios, iflag, icpliter
505	CHARACTER*8 pipnom ! name for the pipe
506	CHARACTER*8 fldnom ! name for the field
507	CHARACTER*8 filnom ! name for the data file
508	c
509	#include "oasis.h"
510	#include "clim.h"
511	INTEGER info, jktm1
512	INTEGER iret, isize
513	c
514	WRITE (nuout,*) " "
515	WRITE (nuout,*) "Fromcpl: Read fields from CPL"
516	WRITE (nuout,*) " "
517	CALL flush (nuout)
518	c
519	IF (cchain.EQ."PIPE") THEN
520	c
521	c sea-surface-temperature:
522	c
523	pipnom = "Sisutesu"
524	fldnom = "SISUTESU"
525	filnom = "atmsst"
526	WRITE (nuout,*) "Waiting for the pipe "//pipnom
527	CALL flush (nuout)
528	#ifdef CRAY
529	READ (pipnom) icpliter
530	#else
531	iret = 0
532	isize = 1
533	CALL pipread(pipnom, icpliter, isize, iret)
534	#endif
535	WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
536	CALL flush (nuout)
537	nuread = 99
538	OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
539	IF (ios .NE. 0) THEN
540	WRITE(nuout,*) "Error while connecting "//filnom, nuread
541	CALL flush (nuout)
542	CALL ABORT("STOP in Fromcpl")
543	ENDIF
544	REWIND (UNIT = nuread)
545	WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
546	CALL flush (nuout)
547	CALL locread(fldnom, sst, imjm, nuread, iflag)
548	IF (iflag .NE. 0) THEN
549	WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
550	WRITE(nuout,*) "jour, iflag = ", jour, iflag
551	CALL flush (nuout)
552	CALL ABORT('STOP in Fromcpl')
553	ENDIF
554	CLOSE(nuread)
555	WRITE(nuout,*) "Succesful for reading "//fldnom
556	CALL flush (nuout)
557	c
558	c open sea albedo:
559	c
560	pipnom = "Sialbedo"
561	fldnom = "SIALBEDO"
562	filnom = "atmice"
563	WRITE (nuout,*) "Waiting for the pipe "//pipnom
564	CALL flush (nuout)
565	#ifdef CRAY
566	READ (pipnom) icpliter
567	#else
568	iret = 0
569	isize = 1
570	CALL pipread(pipnom, icpliter, isize, iret)
571	#endif
572	WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
573	CALL flush (nuout)
574	nuread = 99
575	OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
576	IF (ios .NE. 0) THEN
577	WRITE(nuout,*) "Error while connecting "//filnom, nuread
578	CALL flush (nuout)
579	CALL ABORT("STOP in Fromcpl")
580	ENDIF
581	REWIND (UNIT = nuread)
582	WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
583	CALL flush (nuout)
584	CALL locread(fldnom, alb_sst, imjm, nuread, iflag)
585	IF (iflag .NE. 0) THEN
586	WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
587	WRITE(nuout,*) "jour, iflag = ", jour, iflag
588	CALL flush (nuout)
589	CALL ABORT('STOP in Fromcpl')
590	ENDIF
591	CLOSE(nuread)
592	WRITE(nuout,*) "Succesful for reading "//fldnom
593	CALL flush (nuout)
594	c
595	c sea-ice cover:
596	c
597	pipnom = "Siicecov"
598	fldnom = "SIICECOV"
599	filnom = "atmice"
600	WRITE (nuout,*) "Waiting for the pipe "//pipnom
601	CALL flush (nuout)
602	#ifdef CRAY
603	READ (pipnom) icpliter
604	#else
605	iret = 0
606	isize = 1
607	CALL pipread(pipnom, icpliter, isize, iret)
608	#endif
609	WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
610	CALL flush (nuout)
611	nuread = 99
612	OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
613	IF (ios .NE. 0) THEN
614	WRITE(nuout,*) "Error while connecting "//filnom, nuread
615	CALL flush (nuout)
616	CALL ABORT("STOP in Fromcpl")
617	ENDIF
618	REWIND (UNIT = nuread)
619	WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
620	CALL flush (nuout)
621	CALL locread(fldnom, sic, imjm, nuread, iflag)
622	IF (iflag .NE. 0) THEN
623	WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
624	WRITE(nuout,*) "jour, iflag = ", jour, iflag
625	CALL flush (nuout)
626	CALL ABORT('STOP in Fromcpl')
627	ENDIF
628	CLOSE(nuread)
629	WRITE(nuout,*) "Succesful for reading "//fldnom
630	CALL flush (nuout)
631	c
632	c sea-ice albedo:
633	c
634	pipnom = "Siicealb"
635	fldnom = "SIICEALB"
636	filnom = "atmice"
637	WRITE (nuout,*) "Waiting for the pipe "//pipnom
638	CALL flush (nuout)
639	#ifdef CRAY
640	READ (pipnom) icpliter
641	#else
642	iret = 0
643	isize = 1
644	CALL pipread(pipnom, icpliter, isize, iret)
645	#endif
646	WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
647	CALL flush (nuout)
648	nuread = 99
649	OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
650	IF (ios .NE. 0) THEN
651	WRITE(nuout,*) "Error while connecting "//filnom, nuread
652	CALL flush (nuout)
653	CALL ABORT("STOP in Fromcpl")
654	ENDIF
655	REWIND (UNIT = nuread)
656	WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
657	CALL flush (nuout)
658	CALL locread(fldnom, alb_sic, imjm, nuread, iflag)
659	IF (iflag .NE. 0) THEN
660	WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
661	WRITE(nuout,*) "jour, iflag = ", jour, iflag
662	CALL flush (nuout)
663	CALL ABORT('STOP in Fromcpl')
664	ENDIF
665	CLOSE(nuread)
666	WRITE(nuout,*) "Succesful for reading "//fldnom
667	CALL flush (nuout)
668	c
669	ELSE ! cchain.EQ."CLIM"
670	c
671	jktm1=jour-1
672	c
673	CALL CLIM_Import ('SISUTESU', jktm1, sst, info)
674	IF (info .NE. CLIM_Ok) THEN
675	WRITE(nuout,*)'Pb in reading ', 'SISUTESU'
676	WRITE(nuout,*)'Atmosphere jour is = ',jour
677	WRITE(nuout,*)'Couplage kt is = ',jktm1
678	WRITE(nuout,*)'CLIM error code is = ', info
679	WRITE(nuout,*)'STOP in Fromcpl'
680	CALL abort
681	ENDIF
682	c
683	CALL CLIM_Import ('SIALBEDO', jktm1, alb_sst, info)
684	IF (info .NE. CLIM_Ok) THEN
685	WRITE(nuout,*)'Pb in reading ', 'SIALBEDO'
686	WRITE(nuout,*)'Atmosphere jour is = ',jour
687	WRITE(nuout,*)'Couplage kt is = ',jktm1
688	WRITE(nuout,*)'CLIM error code is = ', info
689	WRITE(nuout,*)'STOP in Fromcpl'
690	CALL abort
691	ENDIF
692	c
693	CALL CLIM_Import ('SIICECOV', jktm1, sic, info)
694	IF (info .NE. CLIM_Ok) THEN
695	WRITE(nuout,*)'Pb in reading ', 'SIICECOV'
696	WRITE(nuout,*)'Atmosphere jour is = ',jour
697	WRITE(nuout,*)'Couplage kt is = ',jktm1
698	WRITE(nuout,*)'CLIM error code is = ', info
699	WRITE(nuout,*)'STOP in Fromcpl'
700	CALL abort
701	ENDIF
702	c
703	CALL CLIM_Import ('SIICEALB', jktm1, alb_sic, info)
704	IF (info .NE. CLIM_Ok) THEN
705	WRITE(nuout,*)'Pb in reading ', 'SIICEALB'
706	WRITE(nuout,*)'Atmosphere jour is = ',jour
707	WRITE(nuout,*)'Couplage kt is = ',jktm1
708	WRITE(nuout,*)'CLIM error code is = ', info
709	WRITE(nuout,*)'STOP in Fromcpl'
710	CALL abort
711	ENDIF
712	c
713	ENDIF ! fin de test sur cchain
714	c
715	RETURN
716	END
717
718	SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre)
719	IMPLICIT none
720	INTEGER kdimax, knulre, kflgre
721	C****
722	C *****************************
723	C * OASIS ROUTINE - LEVEL 0 *
724	C * ------------- ------- *
725	C *****************************
726	C
727	C**** locread - Read binary field on unit knulre
728	C
729	C Purpose:
730	C -------
731	C Find string cdfldn on unit knulre and read array pfield
732	C
733	C** Interface:
734	C ---------
735	C CALL locread (cdfldn, pfield, kdimax, knulre, kflgre)
736	C
737	C Input:
738	C -----
739	C cdfldn : character string locator
740	C kdimax : dimension of field to be read
741	C knulre : logical unit to be read
742	C
743	C Output:
744	C ------
745	C pfield : field array (real 1D)
746	C kflgre : error status flag
747	C
748	C Workspace:
749	C ---------
750	C None
751	C
752	C Externals:
753	C ---------
754	C None
755	C
756	C Reference:
757	C ---------
758	C See OASIS manual (1995)
759	C
760	C History:
761	C -------
762	C Version Programmer Date Description
763	C ------- ---------- ---- -----------
764	C 2.0 L. Terray 95/09/01 created
765	C
766	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
767	C
768	C* ---------------------------- Include files ---------------------------
769	C
770	C
771	C* ---------------------------- Argument declarations -------------------
772	C
773	REAL pfield(kdimax)
774	CHARACTER*8 cdfldn
775	C
776	C* ---------------------------- Local declarations ----------------------
777	C
778	CHARACTER*8 clecfl
779	INTEGER nulou
780	c
781	nulou = 6
782	C
783	C* ---------------------------- Poema verses ----------------------------
784	C
785	C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
786	C
787	C* 1. Initialization
788	C --------------
789	C
790	c WRITE (UNIT = nulou,FMT = *) ' '
791	c WRITE (UNIT = nulou,FMT = *) ' '
792	c WRITE (UNIT = nulou,FMT = *)
793	c $ ' ROUTINE locread - Level 0'
794	c WRITE (UNIT = nulou,FMT = *)
795	c $ ' ************* *****'
796	c WRITE (UNIT = nulou,FMT = *) ' '
797	c WRITE (UNIT = nulou,FMT = 1001) knulre
798	c WRITE (UNIT = nulou,FMT = *) ' '
799	C
800	C* Formats
801	C
802	1001 FORMAT(5X,' Read binary file connected to unit = ',I3)
803	C
804	C 2. Find field in file
805	C ------------------
806	C
807	REWIND knulre
808	200 CONTINUE
809	C* Find string
810	READ (UNIT = knulre, ERR = 210, END = 210) clecfl
811	IF (clecfl .NE. cdfldn) GO TO 200
812	C* Read associated field
813	READ (UNIT = knulre, ERR = 210, END = 210) pfield
814	C* Reading done and ok
815	kflgre = 0
816	GO TO 220
817	C* Problem in reading
818	210 kflgre = 1
819	220 CONTINUE
820	C
821	C
822	C* 3. End of routine
823	C --------------
824	C
825	c WRITE (UNIT = nulou,FMT = *)
826	c $ ' --------- End of routine locread ---------'
827	c WRITE (UNIT = nulou,FMT = *) ' '
828	c CALL FLUSH (nulou)
829	RETURN
830	END
831
832
833	SUBROUTINE intocpl(itau,imjm,
834	. fsol, fnsol,
835	. rain, snow, evap, ruisoce, ruisriv,
836	. tsol, fder, albe,
837	. taux, tauy)
838	IMPLICIT NONE
839	c
840	c Laurent Z.X Li (Feb. 10, 1997): It provides several fields to the
841	c coupler. Of course, it sends a message to the corresponding pipes
842	c after the writting.
843	c
844	INTEGER itau, imjm
845	c
846	REAL fsol(imjm)
847	REAL fnsol(imjm)
848	REAL rain(imjm)
849	REAL snow(imjm)
850	REAL evap(imjm)
851	REAL ruisoce(imjm)
852	REAL ruisriv(imjm)
853	REAL tsol(imjm)
854	REAL fder(imjm)
855	REAL albe(imjm)
856	REAL taux(imjm)
857	REAL tauy(imjm)
858	c
859	INTEGER nuout
860	PARAMETER (nuout = 6)
861	C
862	INTEGER nuwrit, ios
863	CHARACTER*8 pipnom
864	CHARACTER*8 fldnom
865	CHARACTER*8 filnom
866	c
867	c
868	#include "oasis.h"
869	#include "clim.h"
870	INTEGER info
871	INTEGER isize, iret
872	c
873	WRITE(nuout,*) " "
874	WRITE(nuout,*) "Intocpl: send fields to CPL, itau= ", itau
875	WRITE(nuout,*) " "
876	c
877	IF (cchain.EQ."PIPE") THEN
878	c
879	nuwrit = 99
880	filnom = "atmflx"
881	OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
882	IF (ios .NE. 0) THEN
883	WRITE(6,*) "Error while connecting "//filnom
884	CALL ABORT('STOP in intocpl')
885	ENDIF
886	REWIND ( UNIT = nuwrit)
887	c
888	WRITE(nuout,*) " "
889	WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
890	WRITE(nuout,*) " "
891	CALL flush(nuout)
892	C
893	C ecriture CONSFTOT (flux non solaire)
894	C
895	fldnom = "CONSFTOT"
896	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
897	WRITE(UNIT = nuwrit) fnsol
898	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
899	C
900	C ecriture COSHFTOT (solaire)
901	C
902	fldnom = "COSHFTOT"
903	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
904	WRITE(UNIT = nuwrit) fsol
905	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
906	C
907	C ecriture COTOLPSU (precipitation liquide)
908	C
909	fldnom = "COTOLPSU"
910	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
911	WRITE(UNIT = nuwrit) rain
912	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
913	C
914	C ecriture COTOSPSU (precipitation solide)
915	C
916	fldnom = "COTOSPSU"
917	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
918	WRITE(UNIT = nuwrit) snow
919	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
920	C
921	C ecriture COTFSHSU (evaporation)
922	C
923	fldnom = "COTFSHSU"
924	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
925	WRITE(UNIT = nuwrit) evap
926	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
927	C
928	C ecriture COSSTSST (temperature du sol)
929	C
930	fldnom = "COSSTSST"
931	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
932	WRITE(UNIT = nuwrit) tsol
933	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
934	C
935	C ecriture CODFLXDT (derivee du flux non-solaire)
936	C
937	fldnom = "CODFLXDT"
938	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
939	WRITE(UNIT = nuwrit) fder
940	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
941	C
942	C ecriture COALBSUR (albedo moyen)
943	C
944	fldnom = "COALBSUR"
945	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
946	WRITE(UNIT = nuwrit) albe
947	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
948	C
949	C ecriture CORUNCOA (runoff DIRECT)
950	C
951	fldnom = "CORUNCOA"
952	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
953	WRITE(UNIT = nuwrit) ruisoce
954	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
955	C
956	C ecriture river runoff 'CORIVFLU'
957	C
958	fldnom = "CORIVFLU"
959	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
960	WRITE(UNIT = nuwrit) ruisriv
961	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
962	c
963	CLOSE(UNIT = nuwrit)
964	C
965	C simulate a FLUSH
966	C
967	OPEN(nuwrit, FILE=filnom, FORM='unformatted')
968	CLOSE(UNIT = nuwrit)
969	C
970	C Send message to pipes:
971	c
972	pipnom = 'Consftot'
973	#ifdef CRAY
974	WRITE(pipnom) itau
975	#else
976	isize=1
977	iret=0
978	CALL pipwrite(pipnom,itau,isize,iret)
979	#endif
980	WRITE(nuout,*) "Message sent to pipe "//pipnom
981	c
982	pipnom = 'Coshftot'
983	#ifdef CRAY
984	WRITE(pipnom) itau
985	#else
986	isize=1
987	iret=0
988	CALL pipwrite(pipnom,itau,isize,iret)
989	#endif
990	WRITE(nuout,*) "Message sent to pipe "//pipnom
991	c
992	pipnom = 'Cotolpsu'
993	#ifdef CRAY
994	WRITE(pipnom) itau
995	#else
996	isize=1
997	iret=0
998	CALL pipwrite(pipnom,itau,isize,iret)
999	#endif
1000	WRITE(nuout,*) "Message sent to pipe "//pipnom
1001	c
1002	pipnom = 'Cotospsu'
1003	#ifdef CRAY
1004	WRITE(pipnom) itau
1005	#else
1006	isize=1
1007	iret=0
1008	CALL pipwrite(pipnom,itau,isize,iret)
1009	#endif
1010	WRITE(nuout,*) "Message sent to pipe "//pipnom
1011	c
1012	pipnom = 'Cotfshsu'
1013	#ifdef CRAY
1014	WRITE(pipnom) itau
1015	#else
1016	isize=1
1017	iret=0
1018	CALL pipwrite(pipnom,itau,isize,iret)
1019	#endif
1020	WRITE(nuout,*) "Message sent to pipe "//pipnom
1021	c
1022	pipnom = 'Cosstsst'
1023	#ifdef CRAY
1024	WRITE(pipnom) itau
1025	#else
1026	isize=1
1027	iret=0
1028	CALL pipwrite(pipnom,itau,isize,iret)
1029	#endif
1030	WRITE(nuout,*) "Message sent to pipe "//pipnom
1031	c
1032	pipnom = 'Codflxdt'
1033	#ifdef CRAY
1034	WRITE(pipnom) itau
1035	#else
1036	isize=1
1037	iret=0
1038	CALL pipwrite(pipnom,itau,isize,iret)
1039	#endif
1040	WRITE(nuout,*) "Message sent to pipe "//pipnom
1041	c
1042	pipnom = 'Coalbsur'
1043	#ifdef CRAY
1044	WRITE(pipnom) itau
1045	#else
1046	isize=1
1047	iret=0
1048	CALL pipwrite(pipnom,itau,isize,iret)
1049	#endif
1050	WRITE(nuout,*) "Message sent to pipe "//pipnom
1051	c
1052	pipnom = 'Coruncoa'
1053	#ifdef CRAY
1054	WRITE(pipnom) itau
1055	#else
1056	isize=1
1057	iret=0
1058	CALL pipwrite(pipnom,itau,isize,iret)
1059	#endif
1060	WRITE(nuout,*) "Message sent to pipe "//pipnom
1061	c
1062	pipnom = 'Corivflu'
1063	#ifdef CRAY
1064	WRITE(pipnom) itau
1065	#else
1066	isize=1
1067	iret=0
1068	CALL pipwrite(pipnom,itau,isize,iret)
1069	#endif
1070	WRITE(nuout,*) "Message sent to pipe "//pipnom
1071	C
1072	C Send wind stresses to coupler
1073	c
1074	nuwrit = 99
1075	filnom = "atmtau"
1076	OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
1077	IF (ios .NE. 0) THEN
1078	WRITE(6,*) "Error while connecting "//filnom
1079	CALL ABORT('STOP in intocpl')
1080	ENDIF
1081	REWIND ( UNIT = nuwrit)
1082	c
1083	WRITE(nuout,*) " "
1084	WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
1085	WRITE(nuout,*) " "
1086	C
1087	C ecriture COZOTAUX
1088	c
1089	fldnom = "COZOTAUX"
1090	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
1091	WRITE(UNIT = nuwrit) taux
1092	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
1093	c
1094	fldnom = "COZOTAU2"
1095	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
1096	WRITE(UNIT = nuwrit) taux
1097	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
1098	C
1099	C ecriture COMETAUY
1100	C
1101	fldnom = "COMETAUY"
1102	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
1103	WRITE(UNIT = nuwrit) tauy
1104	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
1105	c
1106	fldnom = "COMETAU2"
1107	WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA '
1108	WRITE(UNIT = nuwrit) tauy
1109	WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
1110	c
1111	CLOSE(UNIT = nuwrit)
1112	C
1113	C simulate a FLUSH
1114	C
1115	OPEN(nuwrit, FILE=filnom, FORM='unformatted')
1116	CLOSE(UNIT = nuwrit)
1117	c
1118	c Send message to pipes:
1119	c
1120	pipnom = 'Cozotaux'
1121	#ifdef CRAY
1122	WRITE(pipnom) itau
1123	#else
1124	isize=1
1125	iret=0
1126	CALL pipwrite(pipnom,itau,isize,iret)
1127	#endif
1128	WRITE(nuout,*) "Message sent to pipe "//pipnom
1129	c
1130	pipnom = 'Cozotau2'
1131	#ifdef CRAY
1132	WRITE(pipnom) itau
1133	#else
1134	isize=1
1135	iret=0
1136	CALL pipwrite(pipnom,itau,isize,iret)
1137	#endif
1138	WRITE(nuout,*) "Message sent to pipe "//pipnom
1139	c
1140	pipnom = 'Cometauy'
1141	#ifdef CRAY
1142	WRITE(pipnom) itau
1143	#else
1144	isize=1
1145	iret=0
1146	CALL pipwrite(pipnom,itau,isize,iret)
1147	#endif
1148	WRITE(nuout,*) "Message sent to pipe "//pipnom
1149	c
1150	pipnom = 'Cometau2'
1151	#ifdef CRAY
1152	WRITE(pipnom) itau
1153	#else
1154	isize=1
1155	iret=0
1156	CALL pipwrite(pipnom,itau,isize,iret)
1157	#endif
1158	WRITE(nuout,*) "Message sent to pipe "//pipnom
1159	c
1160	ELSE ! cchain.EQ."CLIM"
1161	c
1162	CALL CLIM_Export("CONSFTOT", itau, fnsol, info)
1163	IF (info .NE. CLIM_Ok) THEN
1164	WRITE (nuout,*) "intocpl: CLIM_Export fnsol pb. ", info
1165	CALL ABORT("STOP in intocpl")
1166	ENDIF
1167	c
1168	CALL CLIM_Export("COSHFTOT", itau, fsol, info)
1169	IF (info .NE. CLIM_Ok) THEN
1170	WRITE (nuout,*) "intocpl: CLIM_Export fsol pb. ", info
1171	CALL ABORT("STOP in intocpl")
1172	ENDIF
1173	c
1174	CALL CLIM_Export("COTOLPSU", itau, rain, info)
1175	IF (info .NE. CLIM_Ok) THEN
1176	WRITE (nuout,*) "intocpl: CLIM_Export rain pb. ", info
1177	CALL ABORT("STOP in intocpl")
1178	ENDIF
1179	c
1180	CALL CLIM_Export("COTOSPSU", itau, snow, info)
1181	IF (info .NE. CLIM_Ok) THEN
1182	WRITE (nuout,*) "intocpl: CLIM_Export snow pb. ", info
1183	CALL ABORT("STOP in intocpl")
1184	ENDIF
1185	c
1186	CALL CLIM_Export("COTFSHSU", itau, evap, info)
1187	IF (info .NE. CLIM_Ok) THEN
1188	WRITE (nuout,*) "intocpl: CLIM_Export evap pb. ", info
1189	CALL ABORT("STOP in intocpl")
1190	ENDIF
1191	c
1192	CALL CLIM_Export("COSSTSST", itau, tsol, info)
1193	IF (info .NE. CLIM_Ok) THEN
1194	WRITE (nuout,*) "intocpl: CLIM_Export tsol pb. ", info
1195	CALL ABORT("STOP in intocpl")
1196	ENDIF
1197	c
1198	CALL CLIM_Export("CODFLXDT", itau, fder, info)
1199	IF (info .NE. CLIM_Ok) THEN
1200	WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
1201	CALL ABORT("STOP in intocpl")
1202	ENDIF
1203	c
1204	CALL CLIM_Export("COALBSUR", itau, albe, info)
1205	IF (info .NE. CLIM_Ok) THEN
1206	WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
1207	CALL ABORT("STOP in intocpl")
1208	ENDIF
1209	c
1210	CALL CLIM_Export("CORUNCOA", itau, ruisoce, info)
1211	IF (info .NE. CLIM_Ok) THEN
1212	WRITE (nuout,*) "intocpl: CLIM_Export ruisoce pb. ", info
1213	CALL ABORT("STOP in intocpl")
1214	ENDIF
1215	c
1216	CALL CLIM_Export("CORIVFLU", itau, ruisriv, info)
1217	IF (info .NE. CLIM_Ok) THEN
1218	WRITE (nuout,*) "intocpl: CLIM_Export ruisriv pb. ", info
1219	CALL ABORT("STOP in intocpl")
1220	ENDIF
1221	c
1222	CALL CLIM_Export("COZOTAUX", itau, taux, info)
1223	IF (info .NE. CLIM_Ok) THEN
1224	WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
1225	CALL ABORT("STOP in intocpl")
1226	ENDIF
1227	c
1228	CALL CLIM_Export("COZOTAU2", itau, taux, info)
1229	IF (info .NE. CLIM_Ok) THEN
1230	WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
1231	CALL ABORT("STOP in intocpl")
1232	ENDIF
1233	c
1234	CALL CLIM_Export("COMETAUY", itau, tauy, info)
1235	IF (info .NE. CLIM_Ok) THEN
1236	WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
1237	CALL ABORT("STOP in intocpl")
1238	ENDIF
1239	c
1240	CALL CLIM_Export("COMETAU2", itau, tauy, info)
1241	IF (info .NE. CLIM_Ok) THEN
1242	WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
1243	CALL ABORT("STOP in intocpl")
1244	ENDIF
1245	c
1246	ENDIF
1247	c
1248	RETURN
1249	END
1250	SUBROUTINE quitcpl
1251	IMPLICIT none
1252	c
1253	c Sortir du coupleur
1254	c
1255	INTEGER nuout ! listing output unit
1256	PARAMETER (nuout=6)
1257	c
1258	#include "oasis.h"
1259	#include "clim.h"
1260	INTEGER info
1261	c
1262	IF (cchain.EQ."PIPE") THEN
1263	c
1264	WRITE(nuout,*)"On sort du coupleur sans rien faire"
1265	c
1266	ELSE ! cchain.EQ."CLIM"
1267	c
1268	CALL CLIM_Quit(CLIM_StopPvm,info)
1269	IF (info.NE.CLIM_Ok) THEN
1270	WRITE(nuout,*)"Erreur pour quiter coupleur:",info
1271	ENDIF
1272	c
1273	ENDIF
1274	c
1275	RETURN
1276	END
1277
1278
1279	SUBROUTINE makepipe
1280	PRINT*, "rien"
1281	END
1282	SUBROUTINE pipwrite
1283	PRINT*, "rien"
1284	END
1285	SUBROUTINE pipread
1286	PRINT*, "rien"
1287	END
1288	SUBROUTINE CLIM_Init
1289	PRINT*, "rien"
1290	END
1291	SUBROUTINE CLIM_Define
1292	PRINT*, "rien"
1293	END
1294	SUBROUTINE CLIM_Start
1295	PRINT*, "rien"
1296	END
1297	SUBROUTINE CLIM_Stepi
1298	PRINT*, "rien"
1299	END
1300	SUBROUTINE CLIM_Import
1301	PRINT*, "rien"
1302	END
1303	SUBROUTINE CLIM_Export
1304	PRINT*, "rien"
1305	END
1306	SUBROUTINE CLIM_quit
1307	PRINT*, "rien"
1308	END

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

Download in other formats:

Original Format