Context Navigation

oasis.psmile @ 556

Last change on this file since 556 was 544, checked in by lmdzadmin, 20 years ago
Incorporation des modifications necessaires a l'utilisation de la librairie Psmile/PRISM, et creation d'un tag IPSL-CM4_PSMILE, selon M.-E. Demory LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 17.6 KB

Rev	Line
[481]	1	! $Header$
	2
	3	MODULE oasis
	4
	5	! Module contenant les routines pour l'initialisation du couplage, la
	6	! lecture et l'ecriture des champs venant/transmis au coupleur
	7	!
	8
	9	IMPLICIT none
	10
	11	PRIVATE
	12	PUBLIC :: inicma, fromcpl, intocpl
	13
	14	INTERFACE inicma
	15	module procedure inicma
	16	END INTERFACE
	17
	18	#include "param_cou.h"
	19
	20	integer, dimension(jpfldo2a), save :: in_var_id
	21	integer, dimension(jpflda2o1+jpflda2o2), save :: il_out_var_id
[544]	22	CHARACTER (len=8), dimension(jpmaxfld), public, save :: cl_writ, cl_read
[481]	23	CHARACTER (len=8), dimension(jpmaxfld), save :: cl_f_writ, cl_f_read
	24
[544]	25	CONTAINS
[481]	26
	27	!****
	28	!
	29	!**** INICMA - Initialize coupled mode communication for atmosphere
	30	! and exchange some initial information with Oasis
	31	!
	32	! Rewrite to take the PRISM/psmile library into account
	33	! LF 09/2003
	34	!
	35	! Input:
	36	! -----
	37	! im, jm: size of grid passed between gcm and coupler
	38	!
	39	! -----------------------------------------------------------
	40	!
	41	SUBROUTINE inicma(im, jm)
	42
	43	use mod_prism_proto
	44	use mod_prism_def_partition_proto
	45
	46	implicit none
	47
	48	#include "param_cou.h"
	49
	50	!
	51	! parameters
	52	!
	53	integer :: im, jm
	54	!
	55	! local variables
	56	!
	57	! integers
	58	!
	59	integer :: comp_id
[544]	60	integer :: ierror, il_commlocal
[481]	61	integer :: il_part_id
	62	integer, dimension(:), allocatable :: ig_paral
[544]	63	! integer, dimension(jpfldo2a) :: in_var_id
	64	! integer, dimension(jpflda2o1+jpflda2o2) :: il_out_var_id
[481]	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	call prism_init_comp_proto (comp_id, clmodnam, ierror)
	97
	98	IF (ierror .ne. PRISM_Ok) THEN
	99	abort_message=' Probleme init dans prism_init_comp '
	100	call abort_gcm(modname,abort_message,1)
	101	ELSE
	102	WRITE(nuout,*) 'inicma : init psmile ok '
	103	ENDIF
	104
[544]	105	! PSMILe attribution of local communicator
[481]	106	!
[544]	107	call prism_get_localcomm_proto (il_commlocal, ierror)
	108	!
[481]	109	! and domain decomposition
	110	!
	111	! monoproc case
	112	!
[544]	113	! allocate(ig_paral(3))
	114	! ig_paral(1) = 0
	115	! ig_paral(2) = 0
	116	! ig_paral(3) = im * jm
	117	allocate(ig_paral(5))
	118	ig_paral (1) = 2
	119	ig_paral (2) = 0
	120	ig_paral (3) = im
	121	ig_paral (4) = jm
	122	ig_paral (5) = im
[481]	123	call prism_def_partition_proto (il_part_id, ig_paral, ierror)
	124	deallocate(ig_paral)
	125	!
	126	IF (ierror .ne. PRISM_Ok) THEN
	127	abort_message=' Probleme dans prism_def_partition '
	128	call abort_gcm(modname,abort_message,1)
	129	ELSE
	130	WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
	131	ENDIF
	132
	133	!
	134	! Field Declarations
	135	!
	136	! Define symbolic name for fields exchanged from atmos to coupler,
	137	! must be the same as (1) of the field definition in namcouple:
	138	!
	139	cl_writ(1)='COSHFICE'
	140	cl_writ(2)='COSHFOCE'
	141	cl_writ(3)='CONSFICE'
	142	cl_writ(4)='CONSFOCE'
	143	cl_writ(5)='CODFLXDT'
	144	cl_writ(6)='COTFSICE'
	145	cl_writ(7)='COTFSOCE'
	146	cl_writ(8)='COTOLPSU'
	147	cl_writ(9)='COTOSPSU'
	148	cl_writ(10)='CORUNCOA'
	149	cl_writ(11)='CORIVFLU'
	150	cl_writ(12)='COCALVIN'
	151	cl_writ(13)='COTAUXXU'
	152	cl_writ(14)='COTAUYYU'
	153	cl_writ(15)='COTAUZZU'
	154	cl_writ(16)='COTAUXXV'
	155	cl_writ(17)='COTAUYYV'
	156	cl_writ(18)='COTAUZZV'
	157	!
	158	! Define symbolic name for fields exchanged from coupler to atmosphere,
	159	! must be the same as (2) of the field definition in namcouple:
	160	!
	161	cl_read(1)='SISUTESW'
	162	cl_read(2)='SIICECOV'
	163	cl_read(3)='SIICEALW'
	164	cl_read(4)='SIICTEMW'
	165
	166	il_var_nodims(1) = 2
	167	il_var_nodims(2) = 1
	168
	169	il_var_actual_shape(1) = 1
	170	il_var_actual_shape(2) = im
	171	il_var_actual_shape(3) = 1
	172	il_var_actual_shape(4) = jm
	173
	174	il_var_type = PRISM_Real
	175	!
	176	! Oceanic Fields
	177	!
	178	DO jf=1, jpfldo2a
	179	call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
	180	& il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
	181	& ierror)
	182	IF (ierror .ne. PRISM_Ok) THEN
	183	abort_message=' Probleme init dans prism_def_var_proto '
	184	call abort_gcm(modname,abort_message,1)
	185	ENDIF
	186	END DO
	187	!
	188	! Atmospheric Fields
	189	!
	190	DO jf=1, jpflda2o1+jpflda2o2
	191	call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, &
	192	& il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
	193	& ierror)
	194	IF (ierror .ne. PRISM_Ok) THEN
	195	abort_message=' Probleme init dans prism_def_var_proto '
	196	call abort_gcm(modname,abort_message,1)
	197	ENDIF
	198	END DO
	199	!
	200	! End
	201	!
	202	call prism_enddef_proto(ierror)
	203	IF (ierror .ne. PRISM_Ok) THEN
	204	abort_message=' Probleme init dans prism_ endef_proto'
	205	call abort_gcm(modname,abort_message,1)
	206	ELSE
	207	WRITE(nuout,*) 'inicma : endef psmile ok '
	208	ENDIF
	209
	210	END SUBROUTINE inicma
	211
	212	SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo)
	213	! ======================================================================
	214	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
	215	! and Sea-Ice provided by the coupler. Adaptation to psmile library
	216	!======================================================================
	217
	218	use mod_prism_proto
	219	use mod_prism_get_proto
	220
	221	IMPLICIT none
	222
	223	!
	224	! parametres
	225	!
	226	integer :: im, jm, kt
	227	real, dimension(im, jm) :: sst ! sea-surface-temperature
	228	real, dimension(im, jm) :: gla ! sea-ice
	229	real, dimension(im, jm) :: tice ! temp glace
	230	real, dimension(im, jm) :: albedo ! albedo glace
	231	!
	232	! local variables
	233	!
	234	integer :: nuout = 6 ! listing output unit
	235	integer :: ierror
	236	character (len = 20),save :: modname = 'fromcpl'
	237	character (len = 80) :: abort_message
	238	!
	239	#include "param_cou.h"
	240	!
	241	!
	242	WRITE (nuout,*) ' '
	243	WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
	244	WRITE (nuout,*) ' '
	245	CALL flush (nuout)
	246
	247	call prism_get_proto(in_var_id(1), kt, sst, ierror)
[544]	248	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
	249	& ierror.ne.PRISM_FromRest &
	250	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
	251	& .and. ierror.ne.PRISM_FromRestOut ) THEN
[481]	252	WRITE (nuout,*) cl_read(1), kt
	253	abort_message=' Probleme dans prism_get_proto '
	254	call abort_gcm(modname,abort_message,1)
	255	endif
	256	call prism_get_proto(in_var_id(2), kt, gla, ierror)
[544]	257	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
	258	& ierror.ne.PRISM_FromRest &
	259	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
	260	& .and. ierror.ne.PRISM_FromRestOut ) THEN
[481]	261	WRITE (nuout,*) cl_read(2), kt
	262	abort_message=' Probleme dans prism_get_proto '
	263	call abort_gcm(modname,abort_message,1)
	264	endif
	265	call prism_get_proto(in_var_id(3), kt, albedo, ierror)
[544]	266	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
	267	& ierror.ne.PRISM_FromRest &
	268	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
	269	& .and. ierror.ne.PRISM_FromRestOut ) THEN
[481]	270	WRITE (nuout,*) cl_read(3), kt
	271	abort_message=' Probleme dans prism_get_proto '
	272	call abort_gcm(modname,abort_message,1)
	273	endif
	274	call prism_get_proto(in_var_id(4), kt, tice, ierror)
[544]	275	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
	276	& ierror.ne.PRISM_FromRest &
	277	& .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
	278	& .and. ierror.ne.PRISM_FromRestOut ) THEN
[481]	279	WRITE (nuout,*) cl_read(4), kt
	280	abort_message=' Probleme dans prism_get_proto '
	281	call abort_gcm(modname,abort_message,1)
	282	endif
	283
	284	!
	285	RETURN
	286	END SUBROUTINE fromcpl
	287
	288	SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, &
	289	& fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, &
	290	& calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v &
	291	& , last)
	292	! ======================================================================
	293	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
	294	! atmospheric coupling fields to the coupler with the psmile library.
	295	! IF last time step, writes output fields to binary files.
	296	! ======================================================================
	297
	298	use mod_prism_proto
	299	use mod_prism_put_proto
	300
	301	IMPLICIT NONE
	302
	303	!
	304	! parametres
	305	!
	306	integer :: kt, im, jm
	307	real, dimension(im, jm) :: fsolice, fsolwat, fnsolwat, fnsolice
	308	real, dimension(im, jm) :: fnsicedt, evice, evwat, lpre, spre
	309	real, dimension(im, jm) :: dirunoff, rivrunoff, calving
	310	real, dimension(im, jm) :: tauxx_u, tauxx_v, tauyy_u
	311	real, dimension(im, jm) :: tauyy_v, tauzz_u, tauzz_v
	312	logical :: last
	313	!
	314	! local
	315	!
	316	integer, parameter :: nuout = 6
	317	integer :: ierror
	318	character (len = 20),save :: modname = 'intocpl'
	319	character (len = 80) :: abort_message
	320	!
	321	!
	322	WRITE(nuout,*) ' '
	323	WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
	324	WRITE(nuout,*) 'last ', last
	325	WRITE(nuout,*)
	326
	327	call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror)
[544]	328	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	329	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	330	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	331	WRITE (nuout,*) cl_writ(1), kt
	332	abort_message=' Probleme dans prism_put_proto '
	333	call abort_gcm(modname,abort_message,1)
	334	endif
	335	call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror)
[544]	336	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	337	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	338	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	339	WRITE (nuout,*) cl_writ(2), kt
	340	abort_message=' Probleme dans prism_put_proto '
	341	call abort_gcm(modname,abort_message,1)
	342	endif
	343	call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror)
[544]	344	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	345	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	346	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	347	WRITE (nuout,*) cl_writ(3), kt
	348	abort_message=' Probleme dans prism_put_proto '
	349	call abort_gcm(modname,abort_message,1)
	350	endif
	351	call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror)
[544]	352	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	353	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	354	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	355	WRITE (nuout,*) cl_writ(4), kt
	356	abort_message=' Probleme dans prism_put_proto '
	357	call abort_gcm(modname,abort_message,1)
	358	endif
	359	call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror)
[544]	360	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	361	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	362	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	363	WRITE (nuout,*) cl_writ(5), kt
	364	abort_message=' Probleme dans prism_put_proto '
	365	call abort_gcm(modname,abort_message,1)
	366	endif
	367	call prism_put_proto(il_out_var_id(6), kt, evice, ierror)
[544]	368	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	369	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	370	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	371	WRITE (nuout,*) cl_writ(6), kt
	372	abort_message=' Probleme dans prism_put_proto '
	373	call abort_gcm(modname,abort_message,1)
	374	endif
	375	call prism_put_proto(il_out_var_id(7), kt, evwat, ierror)
[544]	376	IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
	377	& .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
	378	& ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut ) THEN
[481]	379	WRITE (nuout,*) cl_writ(7), kt
	380	abort_message=' Probleme dans prism_put_proto '
	381	call abort_gcm(modname,abort_message,1)
	382	endif
	383	call prism_put_proto(il_out_var_id(8), kt, lpre, ierror)
[544]	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
[481]	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, spre, ierror)
[544]	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
[481]	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, dirunoff, ierror)
[544]	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
[481]	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, rivrunoff, ierror)
[544]	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
[481]	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, calving, ierror)
[544]	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
[481]	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, tauxx_u, ierror)
[544]	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
[481]	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, tauyy_u, ierror)
[544]	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
[481]	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, tauzz_u, ierror)
[544]	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
[481]	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, tauxx_v, ierror)
[544]	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
[481]	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, tauyy_v, ierror)
[544]	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
[481]	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, tauzz_v, ierror)
[544]	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
[481]	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
	472	if (last) then
	473	call prism_terminate_proto(ierror)
	474	IF (ierror .ne. PRISM_Ok) THEN
	475	WRITE (nuout,*) cl_writ(18), kt
	476	abort_message=' Probleme dans prism_terminate_proto '
	477	call abort_gcm(modname,abort_message,1)
	478	endif
	479	endif
	480
	481
	482	RETURN
	483	END SUBROUTINE intocpl
	484
	485	END MODULE oasis

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

Download in other formats:

Original Format