Context Navigation

oasis.psmile @ 780

Last change on this file since 780 was 776, checked in by Laurent Fairhead, 17 years ago
Suite du merge entre la version et la HEAD: quelques modifications de Yann sur le LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 20.3 KB

Line
1	!
2	! $Header$
3	!
4
5	MODULE oasis
6
7	! Module contenant les routines pour l'initialisation du couplage, la
8	! lecture et l'ecriture des champs venant/transmis au coupleur
9	!
10
11	IMPLICIT none
12
13	PRIVATE
14	PUBLIC :: inicma, fromcpl, intocpl
15
16	INTERFACE inicma
17	module procedure inicma
18	END INTERFACE
19
20	#include "param_cou.h"
21
22	integer, dimension(jpfldo2a), save :: in_var_id
23	integer, dimension(jpflda2o1+jpflda2o2), save :: il_out_var_id
24	CHARACTER (len=8), dimension(jpmaxfld), public, save :: cl_writ, cl_read
25	CHARACTER (len=8), dimension(jpmaxfld), save :: cl_f_writ, cl_f_read
26
27	CONTAINS
28
29	!****
30	!
31	!**** INICMA - Initialize coupled mode communication for atmosphere
32	! and exchange some initial information with Oasis
33	!
34	! Rewrite to take the PRISM/psmile library into account
35	! LF 09/2003
36	!
37	! Input:
38	! -----
39	! im, jm: size of grid passed between gcm and coupler
40	!
41	! -----------------------------------------------------------
42	!
43	SUBROUTINE inicma(im, jm)
44
45	use mod_prism_proto
46	use mod_prism_def_partition_proto
47	use dimphy
48	implicit none
49
50	#include "param_cou.h"
51
52	!
53	! parameters
54	!
55	integer :: im, jm
56	!
57	! local variables
58	!
59	! integers
60	!
61	integer :: comp_id
62	integer :: ierror, il_commlocal
63	integer :: il_part_id
64	integer, dimension(:), allocatable :: ig_paral
65	integer, dimension(2) :: il_var_nodims
66	integer, dimension(4) :: il_var_actual_shape
67	integer :: il_var_type
68	integer :: nuout = 6
69	integer :: jf
70	! characters
71	!
72	character (len = 6) :: clmodnam
73	character (len = 20),save :: modname = 'inicma'
74	character (len = 80) :: abort_message
75
76	!
77	! -----------------------------------------------------------
78	!
79	!* 1. Initializations
80	! ---------------
81	!
82	WRITE(nuout,*) ' '
83	WRITE(nuout,*) ' '
84	WRITE(nuout,*) ' ROUTINE INICMA'
85	WRITE(nuout,) ' *************'
86	WRITE(nuout,*) ' '
87	WRITE(nuout,*) ' '
88	!
89	! Define the model name
90	!
91	clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
92	!
93	!
94	! Here we go: psmile initialisation
95	!
96	IF (is_sequential) THEN
97	call prism_init_comp_proto (comp_id, clmodnam, ierror)
98
99	IF (ierror .ne. PRISM_Ok) THEN
100	abort_message=' Probleme init dans prism_init_comp '
101	call abort_gcm(modname,abort_message,1)
102	ELSE
103	WRITE(nuout,*) 'inicma : init psmile ok '
104	ENDIF
105	ENDIF
106
107	call prism_get_localcomm_proto (il_commlocal, ierror)
108	!
109	! and domain decomposition
110	!
111	! monoproc case
112	!
113	allocate(ig_paral(3))
114	!ym ig_paral(1) = 0
115	!ym ig_paral(2) = 0
116	!ym ig_paral(3) = im * jm
117	ig_paral(1) = 1 ! apple partition for //
118	ig_paral(2) = (jj_begin-1)*im+ii_begin-1
119	ig_paral(3) = (jj_endim+ii_end)-(jj_beginim+ii_begin)+1
120	if (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+im-1
121	print *,mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
122
123	ierror=PRISM_Ok
124	call prism_def_partition_proto (il_part_id, ig_paral, ierror)
125	deallocate(ig_paral)
126	!
127	IF (ierror .ne. PRISM_Ok) THEN
128	abort_message=' Probleme dans prism_def_partition '
129	call abort_gcm(modname,abort_message,1)
130	ELSE
131	WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
132	ENDIF
133
134	!
135	! Field Declarations
136	!
137	! Define symbolic name for fields exchanged from atmos to coupler,
138	! must be the same as (1) of the field definition in namcouple:
139	!
140	cl_writ(1)='COTAUXXU'
141	cl_writ(2)='COTAUYYU'
142	cl_writ(3)='COTAUZZU'
143	cl_writ(4)='COTAUXXV'
144	cl_writ(5)='COTAUYYV'
145	cl_writ(6)='COTAUZZV'
146	! -- LOOP
147	cl_writ(7)='COWINDSP'
148	! -- LOOP
149	cl_writ(8)='COSHFICE'
150	cl_writ(9)='COSHFOCE'
151	cl_writ(10)='CONSFICE'
152	cl_writ(11)='CONSFOCE'
153	cl_writ(12)='CODFLXDT'
154	cl_writ(13)='COTFSICE'
155	cl_writ(14)='COTFSOCE'
156	cl_writ(15)='COTOLPSU'
157	cl_writ(16)='COTOSPSU'
158	cl_writ(17)='CORUNCOA'
159	cl_writ(18)='CORIVFLU'
160	cl_writ(19)='COCALVIN'
161	!
162	! Define symbolic name for fields exchanged from coupler to atmosphere,
163	! must be the same as (2) of the field definition in namcouple:
164	!
165	cl_read(1)='SISUTESW'
166	cl_read(2)='SIICECOV'
167	cl_read(3)='SIICEALW'
168	cl_read(4)='SIICTEMW'
169
170	il_var_nodims(1) = 2
171	il_var_nodims(2) = 1
172
173	il_var_actual_shape(1) = 1
174	il_var_actual_shape(2) = im
175	il_var_actual_shape(3) = 1
176	il_var_actual_shape(4) = jm
177
178	il_var_type = PRISM_Real
179	!
180	! Oceanic Fields
181	!
182	DO jf=1, jpfldo2a
183	call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
184	& il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
185	& ierror)
186	IF (ierror .ne. PRISM_Ok) THEN
187	abort_message=' Probleme init dans prism_def_var_proto '
188	call abort_gcm(modname,abort_message,1)
189	ENDIF
190	END DO
191	!
192	! Atmospheric Fields
193	!
194	DO jf=1, jpflda2o1+jpflda2o2
195	call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, &
196	& il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
197	& ierror)
198	IF (ierror .ne. PRISM_Ok) THEN
199	abort_message=' Probleme init dans prism_def_var_proto '
200	call abort_gcm(modname,abort_message,1)
201	ENDIF
202	END DO
203	!
204	! End
205	!
206	call prism_enddef_proto(ierror)
207	IF (ierror .ne. PRISM_Ok) THEN
208	abort_message=' Probleme init dans prism_ endef_proto'
209	call abort_gcm(modname,abort_message,1)
210	ELSE
211	WRITE(nuout,*) 'inicma : endef psmile ok '
212	ENDIF
213
214	END SUBROUTINE inicma
215
216	SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo)
217	! ======================================================================
218	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
219	! and Sea-Ice provided by the coupler. Adaptation to psmile library
220	!======================================================================
221
222	use mod_prism_proto
223	use mod_prism_get_proto
224	USE dimphy
225	USE mod_phys_lmdz_para
226	IMPLICIT none
227
228	!
229	! parametres
230	!
231	integer :: im, jm, kt
232	real, dimension(im*jm) :: sst ! sea-surface-temperature
233	real, dimension(im*jm) :: gla ! sea-ice
234	real, dimension(im*jm) :: tice ! temp glace
235	real, dimension(im*jm) :: albedo ! albedo glace
236	!
237	! local variables
238	!
239	integer :: nuout = 6 ! listing output unit
240	integer :: ierror
241	character (len = 20),save :: modname = 'fromcpl'
242	character (len = 80) :: abort_message
243	integer :: istart,iend
244	!
245	#include "param_cou.h"
246	!
247	!
248	WRITE (nuout,*) ' '
249	WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
250	WRITE (nuout,*) ' '
251	CALL flush (nuout)
252
253	istart=ii_begin
254	if (is_south_pole) then
255	iend=(jj_end-jj_begin)*im+im
256	else
257	iend=(jj_end-jj_begin)*im+ii_end
258	endif
259
260	call prism_get_proto(in_var_id(1), kt, sst(istart:iend), ierror)
261	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
262	& ierror.ne.PRISM_FromRest &
263	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
264	& .and. ierror.ne.PRISM_FromRestOut) THEN
265	WRITE (nuout,*) cl_read(1), kt
266	abort_message=' Probleme dans prism_get_proto '
267	call abort_gcm(modname,abort_message,1)
268	endif
269	call prism_get_proto(in_var_id(2), kt, gla(istart:iend), ierror)
270	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
271	& ierror.ne.PRISM_FromRest &
272	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
273	& .and. ierror.ne.PRISM_FromRestOut) THEN
274	WRITE (nuout,*) cl_read(2), kt
275	abort_message=' Probleme dans prism_get_proto '
276	call abort_gcm(modname,abort_message,1)
277	endif
278	call prism_get_proto(in_var_id(3), kt, albedo(istart:iend), ierror)
279	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
280	& ierror.ne.PRISM_FromRest &
281	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
282	& .and. ierror.ne.PRISM_FromRestOut) THEN
283	WRITE (nuout,*) cl_read(3), kt
284	abort_message=' Probleme dans prism_get_proto '
285	call abort_gcm(modname,abort_message,1)
286	endif
287	call prism_get_proto(in_var_id(4), kt, tice(istart:iend), ierror)
288	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
289	& ierror.ne.PRISM_FromRest &
290	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
291	& .and. ierror.ne.PRISM_FromRestOut) THEN
292	WRITE (nuout,*) cl_read(4), kt
293	abort_message=' Probleme dans prism_get_proto '
294	call abort_gcm(modname,abort_message,1)
295	endif
296
297	!
298	RETURN
299	END SUBROUTINE fromcpl
300
301	SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, &
302	& fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, &
303	& calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, &
304	! -- LOOP
305	& windsp, &
306	! -- LOOP
307	& last)
308	! ======================================================================
309	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
310	! atmospheric coupling fields to the coupler with the psmile library.
311	! IF last time step, writes output fields to binary files.
312	! ======================================================================
313
314	use mod_prism_proto
315	use mod_prism_put_proto
316	USE dimphy
317	USE mod_phys_lmdz_para
318	use write_field_phy
319	IMPLICIT NONE
320
321	!
322	! parametres
323	!
324	integer :: kt, im, jm
325	real, dimension(im* jm) :: fsolice, fsolwat, fnsolwat, fnsolice
326	real, dimension(im* jm) :: fnsicedt, evice, evwat, lpre, spre
327	real, dimension(im* jm) :: dirunoff, rivrunoff, calving
328	real, dimension(im* jm) :: tauxx_u, tauxx_v, tauyy_u
329	real, dimension(im* jm) :: tauyy_v, tauzz_u, tauzz_v
330	real, dimension(im*jm) :: windsp
331	logical :: last
332	logical :: checkout=.FALSE.
333	integer :: istart,iend
334	integer :: wstart,wend
335	!
336	! local
337	!
338	integer, parameter :: nuout = 6
339	integer :: ierror
340	character (len = 20),save :: modname = 'intocpl'
341	character (len = 80) :: abort_message
342	!
343	!
344	WRITE(nuout,*) ' '
345	WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
346	WRITE(nuout,*) 'last ', last
347	WRITE(nuout,*)
348
349	istart=ii_begin
350	if (is_south_pole) then
351	iend=(jj_end-jj_begin)*im+im
352	else
353	iend=(jj_end-jj_begin)*im+ii_end
354	endif
355
356	IF (checkout) THEN
357	wstart=istart
358	wend=iend
359	IF (is_north_pole) wstart=istart+im-1
360	IF (is_south_pole) wend=iend-im+1
361
362	CALL writeField_phy("fsolice",fsolice(wstart:wend),1)
363	CALL writeField_phy("fsolwat",fsolwat(wstart:wend),1)
364	CALL writeField_phy("fnsolice",fnsolice(wstart:wend),1)
365	CALL writeField_phy("fnsolwat",fnsolwat(wstart:wend),1)
366	CALL writeField_phy("fnsicedt",fnsicedt(wstart:wend),1)
367	CALL writeField_phy("evice",evice(wstart:wend),1)
368	CALL writeField_phy("evwat",evwat(wstart:wend),1)
369	CALL writeField_phy("lpre",lpre(wstart:wend),1)
370	CALL writeField_phy("spre",spre(wstart:wend),1)
371	CALL writeField_phy("dirunoff",dirunoff(wstart:wend),1)
372	CALL writeField_phy("rivrunoff",rivrunoff(wstart:wend),1)
373	CALL writeField_phy("calving",calving(wstart:wend),1)
374	CALL writeField_phy("tauxx_u",tauxx_u(wstart:wend),1)
375	CALL writeField_phy("tauyy_u",tauyy_u(wstart:wend),1)
376	CALL writeField_phy("tauzz_u",tauzz_u(wstart:wend),1)
377	CALL writeField_phy("tauxx_v",tauxx_v(wstart:wend),1)
378	CALL writeField_phy("tauyy_v",tauyy_v(wstart:wend),1)
379	CALL writeField_phy("tauzz_v",tauzz_v(wstart:wend),1)
380	CALL writeField_phy("windsp",windsp(wstart:wend),1)
381	ENDIF
382
383	call prism_put_proto(il_out_var_id(8), kt, fsolice(istart:iend), ierror)
384	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
385	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
386	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
387	WRITE (nuout,*) cl_writ(8), kt
388	abort_message=' Probleme dans prism_put_proto '
389	call abort_gcm(modname,abort_message,1)
390	endif
391	call prism_put_proto(il_out_var_id(9), kt, fsolwat(istart:iend), ierror)
392	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
393	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
394	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
395	WRITE (nuout,*) cl_writ(9), kt
396	abort_message=' Probleme dans prism_put_proto '
397	call abort_gcm(modname,abort_message,1)
398	endif
399	call prism_put_proto(il_out_var_id(10), kt, fnsolice(istart:iend), ierror)
400	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
401	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
402	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
403	WRITE (nuout,*) cl_writ(10), kt
404	abort_message=' Probleme dans prism_put_proto '
405	call abort_gcm(modname,abort_message,1)
406	endif
407	call prism_put_proto(il_out_var_id(11), kt, fnsolwat(istart:iend), ierror)
408	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
409	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
410	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
411	WRITE (nuout,*) cl_writ(11), kt
412	abort_message=' Probleme dans prism_put_proto '
413	call abort_gcm(modname,abort_message,1)
414	endif
415	call prism_put_proto(il_out_var_id(12), kt, fnsicedt(istart:iend), ierror)
416	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
417	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
418	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
419	WRITE (nuout,*) cl_writ(12), kt
420	abort_message=' Probleme dans prism_put_proto '
421	call abort_gcm(modname,abort_message,1)
422	endif
423	call prism_put_proto(il_out_var_id(13), kt, evice(istart:iend), ierror)
424	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
425	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
426	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
427	WRITE (nuout,*) cl_writ(13), kt
428	abort_message=' Probleme dans prism_put_proto '
429	call abort_gcm(modname,abort_message,1)
430	endif
431	call prism_put_proto(il_out_var_id(14), kt, evwat(istart:iend), ierror)
432	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
433	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
434	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
435	WRITE (nuout,*) cl_writ(14), kt
436	abort_message=' Probleme dans prism_put_proto '
437	call abort_gcm(modname,abort_message,1)
438	endif
439	call prism_put_proto(il_out_var_id(15), kt, lpre(istart:iend), ierror)
440	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
441	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
442	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
443	WRITE (nuout,*) cl_writ(15), kt
444	abort_message=' Probleme dans prism_put_proto '
445	call abort_gcm(modname,abort_message,1)
446	endif
447	call prism_put_proto(il_out_var_id(16), kt, spre(istart:iend), ierror)
448	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
449	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
450	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
451	WRITE (nuout,*) cl_writ(16), kt
452	abort_message=' Probleme dans prism_put_proto '
453	call abort_gcm(modname,abort_message,1)
454	endif
455	call prism_put_proto(il_out_var_id(17), kt, dirunoff(istart:iend), ierror)
456	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
457	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
458	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
459	WRITE (nuout,*) cl_writ(17), kt
460	abort_message=' Probleme dans prism_put_proto '
461	call abort_gcm(modname,abort_message,1)
462	endif
463	call prism_put_proto(il_out_var_id(18), kt, rivrunoff(istart:iend), ierror)
464	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
465	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
466	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
467	WRITE (nuout,*) cl_writ(18), kt
468	abort_message=' Probleme dans prism_put_proto '
469	call abort_gcm(modname,abort_message,1)
470	endif
471	call prism_put_proto(il_out_var_id(19), kt, calving(istart:iend), ierror)
472	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
473	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
474	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
475	WRITE (nuout,*) cl_writ(19), kt
476	abort_message=' Probleme dans prism_put_proto '
477	call abort_gcm(modname,abort_message,1)
478	endif
479	call prism_put_proto(il_out_var_id(1), kt, tauxx_u(istart:iend), ierror)
480	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
481	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
482	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
483	WRITE (nuout,*) cl_writ(1), kt
484	abort_message=' Probleme dans prism_put_proto '
485	call abort_gcm(modname,abort_message,1)
486	endif
487	call prism_put_proto(il_out_var_id(2), kt, tauyy_u(istart:iend), ierror)
488	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
489	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
490	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
491	WRITE (nuout,*) cl_writ(2), kt
492	abort_message=' Probleme dans prism_put_proto '
493	call abort_gcm(modname,abort_message,1)
494	endif
495	call prism_put_proto(il_out_var_id(3), kt, tauzz_u(istart:iend), ierror)
496	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
497	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
498	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
499	WRITE (nuout,*) cl_writ(3), kt
500	abort_message=' Probleme dans prism_put_proto '
501	call abort_gcm(modname,abort_message,1)
502	endif
503	call prism_put_proto(il_out_var_id(4), kt, tauxx_v(istart:iend), ierror)
504	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
505	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
506	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
507	WRITE (nuout,*) cl_writ(4), kt
508	abort_message=' Probleme dans prism_put_proto '
509	call abort_gcm(modname,abort_message,1)
510	endif
511	call prism_put_proto(il_out_var_id(5), kt, tauyy_v(istart:iend), ierror)
512	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
513	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
514	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
515	WRITE (nuout,*) cl_writ(5), kt
516	abort_message=' Probleme dans prism_put_proto '
517	call abort_gcm(modname,abort_message,1)
518	endif
519	call prism_put_proto(il_out_var_id(6), kt, tauzz_v(istart:iend), ierror)
520	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
521	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
522	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
523	WRITE (nuout,*) cl_writ(6), kt
524	abort_message=' Probleme dans prism_put_proto '
525	call abort_gcm(modname,abort_message,1)
526	endif
527	call prism_put_proto(il_out_var_id(7), kt, windsp(istart:iend), ierror)
528	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
529	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
530	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
531	WRITE (nuout,*) cl_writ(7), kt
532	abort_message=' Probleme dans prism_put_proto '
533	call abort_gcm(modname,abort_message,1)
534	endif
535
536	if (last) then
537	IF (is_sequential) THEN
538	call prism_terminate_proto(ierror)
539	IF (ierror .ne. PRISM_Ok) THEN
540	abort_message=' Probleme dans prism_terminate_proto '
541	call abort_gcm(modname,abort_message,1)
542	endif
543	ENDIF
544	endif
545
546
547	RETURN
548	END SUBROUTINE intocpl
549
550	END MODULE oasis

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

Download in other formats:

Original Format