Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

oasis.true @ 5415

Last change on this file since 5415 was 129, checked in by lmdzadmin, 24 years ago
Version des routines de couplage contenant de vrais appels aux librairies CLIM etc. LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 18.0 KB

Line
1	C $Id: oasis.true 129 2000-09-13 09:35:40Z fairhead $
2	C****
3	C
4	C**** INICMA - Initialize coupled mode communication for atmosphere
5	C and exchange some initial information with Oasis
6	C
7	C Input:
8	C -----
9	C KASTP : total number of timesteps in atmospheric model
10	C KEXCH : frequency of exchange (in time steps)
11	C KSTEP : length of timestep (in seconds)
12	C
13	C -----------------------------------------------------------
14	C
15	SUBROUTINE inicma(kastp,kexch,kstep,imjm)
16	c
17	c INCLUDE 'param.h'
18	c
19	INTEGER kastp, kexch, kstep,imjm
20	INTEGER iparal(3)
21	INTEGER ifcpl, idt, info, imxtag, istep, jf
22	c
23	INCLUDE 'param_cou.h'
24	INCLUDE 'inc_cpl.h'
25	CHARACTER*3 cljobnam ! experiment name
26	CHARACTER*6 clmodnam ! model name
27	c EM: not used by Oasis2.4
28	CEM CHARACTER*6 clbid(2) ! for CLIM_Init call (not used)
29	CEM ! must be dimensioned by the number of models
30	CEM INTEGER nbid(2) ! for CLIM_Init call (not used)
31	CEM ! must be dimensioned by the number of models
32	CHARACTER*5 cloasis ! coupler name (Oasis)
33	INTEGER imess(4)
34	INTEGER getpid ! system functions
35	INTEGER nuout
36	CEM LOGICAL llmodel
37	PARAMETER (nuout = 6)
38	c
39	INCLUDE 'clim.h'
40	INCLUDE 'mpiclim.h'
41	c
42	INCLUDE 'oasis.h' ! contains the name of communication technique. Here
43	! cchan=CLIM only is possible.
44	c ! ctype=MPI2
45	c
46	C -----------------------------------------------------------
47	C
48	C* 1. Initializations
49	C ---------------
50	C
51	WRITE(nuout,*) ' '
52	WRITE(nuout,*) ' '
53	WRITE(nuout,*) ' ROUTINE INICMA'
54	WRITE(nuout,) ' *************'
55	WRITE(nuout,*) ' '
56	WRITE(nuout,*) ' '
57	c
58	c Define the model name
59	c
60	clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
61	c
62	c Define the coupler name
63	c
64	cloasis = 'Oasis' ! always 'Oasis' as in the coupler
65	c
66	c
67	c Define symbolic name for fields exchanged from atmos to coupler,
68	c must be the same as (1) of the field definition in namcouple:
69	c
70	cl_writ(1)='COSHFICE'
71	cl_writ(2)='COSHFOCE'
72	cl_writ(3)='CONSFICE'
73	cl_writ(4)='CONSFOCE'
74	cl_writ(5)='CODFLXDT'
75	c cl_writ(6)='COICTEMP'
76	cl_writ(6)='COTFSICE'
77	cl_writ(7)='COTFSOCE'
78	cl_writ(8)='COTOLPSU'
79	cl_writ(9)='COTOSPSU'
80	cl_writ(10)='CORUNCOA'
81	cl_writ(11)='CORIVFLU'
82	cl_writ(12)='COZOTAUX'
83	cl_writ(13)='COZOTAUV'
84	cl_writ(14)='COMETAUY'
85	cl_writ(15)='COMETAUU'
86	c
87	c Define files name for fields exchanged from atmos to coupler,
88	c must be the same as (6) of the field definition in namcouple:
89	c
90	cl_f_writ(1)='flxatmos'
91	cl_f_writ(2)='flxatmos'
92	cl_f_writ(3)='flxatmos'
93	cl_f_writ(4)='flxatmos'
94	cl_f_writ(5)='flxatmos'
95	cl_f_writ(6)='flxatmos'
96	cl_f_writ(7)='flxatmos'
97	cl_f_writ(8)='flxatmos'
98	cl_f_writ(9)='flxatmos'
99	cl_f_writ(10)='flxatmos'
100	cl_f_writ(11)='flxatmos'
101	cl_f_writ(12)='flxatmos'
102	cl_f_writ(13)='flxatmos'
103	cl_f_writ(14)='flxatmos'
104	cl_f_writ(15)='flxatmos'
105	c cl_f_writ(16)='flxatmos'
106	c
107	c
108	c Define symbolic name for fields exchanged from coupler to atmosphere,
109	c must be the same as (2) of the field definition in namcouple:
110	c
111	cl_read(1)='SISUTESW'
112	cl_read(2)='SIICECOV'
113	cl_read(3)='SIICEALW'
114	cl_read(4)='SIICTEMW'
115	c
116	c Define files names for fields exchanged from coupler to atmosphere,
117	c must be the same as (7) of the field definition in namcouple:
118	c
119	cl_f_read(1)='sstatmos'
120	cl_f_read(2)='sstatmos'
121	cl_f_read(3)='sstatmos'
122	cl_f_read(4)='sstatmos'
123	c
124	c
125	c Define the number of processors involved in the coupling for
126	c Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
127	c in the namcouple); they will be stored in a COMMON in mpiclim.h
128	c (used for CLIM/MPI2 only)
129	mpi_nproc(0)=1
130	mpi_nproc(1)=1
131	mpi_nproc(2)=1
132	c
133	c Define infos to be sent initially to oasis
134	c
135	imess(1) = kastp ! total number of timesteps in atmospheric model
136	imess(2) = kexch ! period of exchange (in time steps)
137	imess(3) = kstep ! length of atmospheric timestep (in seconds)
138	imess(4) = getpid() ! PID of atmospheric model
139	c
140	c Initialization and exchange of initial info in the CLIM technique
141	c
142	IF (cchan.eq.'CLIM') THEN
143	c
144	c Define the experiment name :
145	c
146	cljobnam = 'CLI' ! as $JOBNAM in namcouple
147	c
148	c Start the coupling
149	c (see lib/clim/src/CLIM_Init for the definition of input parameters)
150	c
151	cEM clbid(1)=' '
152	cEM clbid(2)=' '
153	cEM nbid(1)=0
154	cEM nbid(2)=0
155	CEM llmodel=.true.
156	c
157	c Define the number of processors used by each model as in
158	c $CHATYPE line of namcouple (used for CLIM/MPI2 only)
159	mpi_totproc(1)=1
160	mpi_totproc(2)=1
161	c
162	c Define names of each model as in $NBMODEL line of namcouple
163	c (used for CLIM/MPI2 only)
164	cmpi_modnam(1)='lmdz.x'
165	cmpi_modnam(2)='oce.xx'
166	c Start the coupling
167	c
168	CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
169	* kastp, kexch, kstep,
170	* 5, 3600, 3600, info )
171	c
172	IF (info.ne.CLIM_Ok) THEN
173	WRITE ( nuout, *) ' inicma : pb init clim '
174	WRITE ( nuout, *) ' error code is = ', info
175	CALL halte('STOP in inicma')
176	ELSE
177	WRITE(nuout,*) 'inicma : init clim ok '
178	ENDIF
179	c
180	c For each coupling field, association of a port to its symbolic name
181	c
182	c -Define the parallel decomposition associated to the port of each
183	c field; here no decomposition for all ports.
184	iparal ( clim_strategy ) = clim_serial
185	iparal ( clim_length ) = imjm
186	iparal ( clim_offset ) = 0
187	c
188	c -Loop on total number of coupler-to-atmosphere fields
189	c (see lib/clim/src/CLIM_Define for the definition of input parameters)
190	DO jf=1, jpfldo2a
191	CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
192	$ , info )
193	END DO
194	c
195	c -Loop on total number of atmosphere-to-coupler fields
196	c (see lib/clim/src/CLIM_Define for the definition of input parameters)
197	DO jf=1, jpflda2o1+jpflda2o2
198	CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
199	$ iparal, info )
200	END DO
201	c
202	WRITE(nuout,*) 'inicma : clim_define ok '
203	c
204	c -Join a pvm group, wait for other programs and broadcast usefull
205	c informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
206	CALL CLIM_Start ( imxtag, info )
207	IF (info.ne.clim_ok) THEN
208	WRITE ( nuout, *) 'inicma : pb start clim '
209	WRITE ( nuout, *) ' error code is = ', info
210	CALL halte('stop in inicma')
211	ELSE
212	WRITE ( nuout, *) 'inicma : start clim ok '
213	ENDIF
214	c
215	c -Get initial information from Oasis
216	c (see lib/clim/src/CLIM_Stepi)
217	CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
218	IF (info .NE. clim_ok) THEN
219	WRITE ( UNIT = nuout, FMT = *)
220	$ ' warning : problem in getting step info ',
221	$ 'from oasis '
222	WRITE (UNIT = nuout, FMT = *)
223	$ ' ======= error code number = ', info
224	ELSE
225	WRITE (UNIT = nuout, FMT = *)
226	$ ' got step information from oasis '
227	ENDIF
228	WRITE ( nuout, *) ' number of tstep in oasis ', istep
229	WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
230	WRITE ( nuout, *) ' length of tstep in oasis ', idt
231	ENDIF
232
233	RETURN
234	END
235
236	c $Id: oasis.true 129 2000-09-13 09:35:40Z fairhead $
237	SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
238	c ======================================================================
239	c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST
240	c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
241	c technique.
242	c======================================================================
243	IMPLICIT none
244	INTEGER imjm, kt
245	REAL sst(imjm) ! sea-surface-temperature
246	REAL gla(imjm) ! sea-ice
247	REAL tice(imjm) ! temp glace
248	REAL albedo(imjm) ! albedo glace
249	c
250	INTEGER nuout ! listing output unit
251	PARAMETER (nuout=6)
252	c
253	INTEGER nuread, ios, iflag, icpliter
254	INTEGER info, jf
255	c
256	INCLUDE 'clim.h'
257	c
258	INCLUDE 'oasis.h'
259	INCLUDE 'param_cou.h'
260	c
261	INCLUDE 'inc_cpl.h'
262	c
263	c
264	WRITE (nuout,*) ' '
265	WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
266	WRITE (nuout,*) ' '
267	CALL flush (nuout)
268
269
270	IF (cchan.eq.'CLIM') THEN
271
272	c
273	c -Get interpolated oceanic fields from Oasis
274	c
275	DO jf=1,jpfldo2a
276	IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
277	IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
278	IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
279	IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
280	IF ( info .NE. CLIM_Ok) THEN
281	WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
282	WRITE(nuout,*)'Couplage kt is = ',kt
283	WRITE(nuout,*)'CLIM error code is = ', info
284	CALL halte('STOP in fromcpl.F')
285	ENDIF
286	END DO
287
288	ENDIF
289	c
290	RETURN
291	END
292
293	c $Id: oasis.true 129 2000-09-13 09:35:40Z fairhead $
294	SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
295	$ fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
296	$ tauxu, tauxv, tauyv, tauyu, last)
297	c ======================================================================
298	c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
299	c atmospheric coupling fields to the coupler with the CLIM (PVM exchange
300	c messages) technique.
301	c IF last time step, writes output fields to binary files.
302	c ======================================================================
303	IMPLICIT NONE
304	INTEGER kt, imjm
305	c
306	REAL fsolice(imjm)
307	REAL fsolwat(imjm)
308	REAL fnsolice(imjm)
309	REAL fnsolwat(imjm)
310	REAL fnsicedt(imjm)
311	REAL ictemp(imjm)
312	REAL evice(imjm)
313	REAL evwat(imjm)
314	REAL lpre(imjm)
315	REAL spre(imjm)
316	REAL dirunoff(imjm)
317	REAL rivrunoff(imjm)
318	REAL tauxu(imjm)
319	REAL tauxv(imjm)
320	REAL tauyu(imjm)
321	REAL tauyv(imjm)
322	LOGICAL last
323	c
324	INTEGER nuout
325	PARAMETER (nuout = 6)
326	c
327	INCLUDE 'clim.h'
328	INCLUDE 'param_cou.h'
329	INCLUDE 'inc_cpl.h'
330	c
331	CHARACTER*8 file_name(jpmaxfld)
332	INTEGER max_file
333	INTEGER file_unit_max, file_unit(jpmaxfld),
334	$ file_unit_field(jpmaxfld)
335
336	INTEGER icstep, info, jn, jf, ierror
337	LOGICAL trouve
338	c
339	INCLUDE 'oasis.h'
340	c
341	icstep=kt
342	c
343	WRITE(nuout,*) ' '
344	WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
345	WRITE(nuout,*) ' '
346
347	IF (last) THEN
348	c
349	c -WRITE fields to binary files for coupler restart at last time step
350	c
351	c -initialisation and files opening
352	c
353	max_file=1
354	file_unit_max=99
355	c -keeps first file name
356	file_name(max_file)=cl_f_writ(max_file)
357	c -keeps first file unit
358	file_unit(max_file)=file_unit_max
359	c -decrements file unit maximum
360	file_unit_max=file_unit_max-1
361	c -keeps file unit for field
362	file_unit_field(1)=file_unit(max_file)
363	c
364	c -different files names counter
365	c
366	DO jf= 2, jpflda2o1 + jpflda2o2
367	trouve=.false.
368	DO jn= 1, max_file
369	IF (.not.trouve) THEN
370	IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
371	c -keep file unit for field
372	file_unit_field(jf)=file_unit(jn)
373	trouve=.true.
374	END IF
375	END IF
376	END DO
377	IF (.not.trouve) then
378	c -increment the number of different files
379	max_file=max_file+1
380	c -keep file name
381	file_name(max_file)=cl_f_writ(jf)
382	c -keep file unit for file
383	file_unit(max_file)=file_unit_max
384	c -keep file unit for field
385	file_unit_field(jf)=file_unit(max_file)
386	c -decrement unit maximum number from 99 to 98, ...
387	file_unit_max=file_unit_max-1
388	END IF
389	END DO
390	c
391	DO jn=1, max_file
392	OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
393	END DO
394	c
395	c WRITE fields to files
396	DO jf=1, jpflda2o1 + jpflda2o2
397	IF (jf.eq.1)
398	$ CALL locwrite(cl_writ(jf),fsolice, imjm,
399	$ file_unit_field(jf), ierror, nuout)
400	IF (jf.eq.2)
401	$ CALL locwrite(cl_writ(jf),fsolwat, imjm,
402	$ file_unit_field(jf), ierror, nuout)
403	IF (jf.eq.3)
404	$ CALL locwrite(cl_writ(jf),fnsolice, imjm,
405	$ file_unit_field(jf), ierror, nuout)
406	IF (jf.eq.4)
407	$ CALL locwrite(cl_writ(jf),fnsolwat, imjm,
408	$ file_unit_field(jf), ierror, nuout)
409	IF (jf.eq.5)
410	$ CALL locwrite(cl_writ(jf),fnsicedt, imjm,
411	$ file_unit_field(jf), ierror, nuout)
412	c IF (jf.eq.6)
413	c $ CALL locwrite(cl_writ(jf),ictemp, imjm,
414	c $ file_unit_field(jf), ierror, nuout)
415	IF (jf.eq.6)
416	$ CALL locwrite(cl_writ(jf),evice, imjm,
417	$ file_unit_field(jf), ierror, nuout)
418	IF (jf.eq.7)
419	$ CALL locwrite(cl_writ(jf),evwat, imjm,
420	$ file_unit_field(jf), ierror, nuout)
421	IF (jf.eq.8)
422	$ CALL locwrite(cl_writ(jf),lpre, imjm,
423	$ file_unit_field(jf), ierror, nuout)
424	IF (jf.eq.9)
425	$ CALL locwrite(cl_writ(jf),spre, imjm,
426	$ file_unit_field(jf), ierror, nuout)
427	IF (jf.eq.10)
428	$ CALL locwrite(cl_writ(jf),dirunoff, imjm,
429	$ file_unit_field(jf), ierror, nuout)
430	IF (jf.eq.11)
431	$ CALL locwrite(cl_writ(jf),rivrunoff, imjm,
432	$ file_unit_field(jf), ierror, nuout)
433	IF (jf.eq.12)
434	$ CALL locwrite(cl_writ(jf),tauxu, imjm,
435	$ file_unit_field(jf),ierror, nuout)
436	IF (jf.eq.13)
437	$ CALL locwrite(cl_writ(jf),tauxv, imjm,
438	$ file_unit_field(jf),ierror, nuout)
439	IF (jf.eq.14)
440	$ CALL locwrite(cl_writ(jf),tauyv, imjm,
441	$ file_unit_field(jf),ierror, nuout)
442	IF (jf.eq.15)
443	$ CALL locwrite(cl_writ(jf),tauyu, imjm,
444	$ file_unit_field(jf), ierror, nuout)
445	END DO
446	C
447	C -simulate a FLUSH
448	C
449	DO jn=1, max_file
450	CLOSE (file_unit(jn))
451	END DO
452	C
453	C
454	IF(cchan.eq.'CLIM') THEN
455	C
456	C -inform PVM daemon that message exchange is finished
457	C
458	CALL CLIM_Quit (CLIM_ContPvm, info)
459	IF (info .NE. CLIM_Ok) THEN
460	WRITE (6, *)
461	$ 'An error occured while leaving CLIM. Error = ',
462	$ info
463	ENDIF
464	END IF
465	RETURN
466	END IF
467	C
468	IF(cchan.eq.'CLIM') THEN
469	C
470	C -Give atmospheric fields to Oasis
471	C
472	DO jn=1, jpflda2o1 + jpflda2o2
473	C
474	IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
475	IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
476	IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
477	IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
478	IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
479	c IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
480	IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
481	IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
482	IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
483	IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
484	IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
485	IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
486	IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
487	IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
488	IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
489	IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
490
491	IF (info .NE. CLIM_Ok) THEN
492	WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
493	WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
494	WRITE (nuout,*) 'Clim error code is = ',info
495	CALL halte('STOP in intocpl ')
496	ENDIF
497	END DO
498	ENDIF
499	C
500	RETURN
501	END
502
503	SUBROUTINE pipe_model_define
504	print*,'Attention dans oasis.F, pipe_model_define est non defini'
505	RETURN
506	END
507
508	SUBROUTINE pipe_model_stepi
509	print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
510	RETURN
511	END
512
513	SUBROUTINE pipe_model_recv
514	print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
515	RETURN
516	END
517
518	SUBROUTINE pipe_model_send
519	print *, 'Attention dans oasis.F, pipe_model_send est non defini'
520	RETURN
521	END
522
523	SUBROUTINE quitcpl
524	print *, 'Attention dans oasis.F, quitcpl est non defini'
525	RETURN
526	END
527
528	SUBROUTINE sipc_write_model
529	print *, 'Attention dans oasis.F, sipc_write_model est non defini'
530	RETURN
531	END
532
533	SUBROUTINE sipc_attach
534	print *, 'Attention dans oasis.F, sipc_attach est non defini'
535	RETURN
536	END
537
538	SUBROUTINE sipc_init_model
539	print *, 'Attention dans oasis.F, sipc_init_model est non defini'
540	RETURN
541	END
542
543	SUBROUTINE sipc_read_model
544	print *, 'Attention dans oasis.F, sipc_read_model est non defini'
545	RETURN
546	END

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

Download in other formats:

Original Format