Context Navigation

oasis.F @ 2

Last change on this file since 2 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

Rev	Line
[2]	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