Context Navigation

oasis.F90 @ 3409

Last change on this file since 3409 was 3102, checked in by oboucher, 7 years ago
Removing x permission from these files
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 18.9 KB

Rev	Line
[782]	1	!
	2	MODULE oasis
	3	!
	4	! This module contains subroutines for initialization, sending and receiving
	5	! towards the coupler OASIS3. It also contains some parameters for the coupling.
	6	!
	7	! This module should always be compiled. With the coupler OASIS3 available the cpp key
	8	! CPP_COUPLE should be set and the entier of this file will then be compiled.
	9	! In a forced mode CPP_COUPLE should not be defined and the compilation ends before
	10	! the CONTAINS, without compiling the subroutines.
	11	!
	12	USE dimphy
	13	USE mod_phys_lmdz_para
	14	USE write_field_phy
	15
	16	#ifdef CPP_COUPLE
[1965]	17	! Use of Oasis-MCT coupler
	18	#if defined CPP_OMCT
	19	USE mod_prism
	20	! Use of Oasis3 coupler
	21	#else
[782]	22	USE mod_prism_proto
	23	USE mod_prism_def_partition_proto
	24	USE mod_prism_get_proto
	25	USE mod_prism_put_proto
	26	#endif
[1965]	27	#endif
[782]	28
	29	IMPLICIT NONE
[1279]	30
	31	! Id for fields sent to ocean
	32	INTEGER, PARAMETER :: ids_tauxxu = 1
	33	INTEGER, PARAMETER :: ids_tauyyu = 2
	34	INTEGER, PARAMETER :: ids_tauzzu = 3
	35	INTEGER, PARAMETER :: ids_tauxxv = 4
	36	INTEGER, PARAMETER :: ids_tauyyv = 5
	37	INTEGER, PARAMETER :: ids_tauzzv = 6
	38	INTEGER, PARAMETER :: ids_windsp = 7
	39	INTEGER, PARAMETER :: ids_shfice = 8
	40	INTEGER, PARAMETER :: ids_shfoce = 9
	41	INTEGER, PARAMETER :: ids_shftot = 10
	42	INTEGER, PARAMETER :: ids_nsfice = 11
	43	INTEGER, PARAMETER :: ids_nsfoce = 12
	44	INTEGER, PARAMETER :: ids_nsftot = 13
	45	INTEGER, PARAMETER :: ids_dflxdt = 14
	46	INTEGER, PARAMETER :: ids_totrai = 15
	47	INTEGER, PARAMETER :: ids_totsno = 16
	48	INTEGER, PARAMETER :: ids_toteva = 17
	49	INTEGER, PARAMETER :: ids_icevap = 18
	50	INTEGER, PARAMETER :: ids_ocevap = 19
	51	INTEGER, PARAMETER :: ids_calvin = 20
	52	INTEGER, PARAMETER :: ids_liqrun = 21
	53	INTEGER, PARAMETER :: ids_runcoa = 22
	54	INTEGER, PARAMETER :: ids_rivflu = 23
	55	INTEGER, PARAMETER :: ids_atmco2 = 24
	56	INTEGER, PARAMETER :: ids_taumod = 25
[2872]	57	INTEGER, PARAMETER :: ids_qraioc = 26
	58	INTEGER, PARAMETER :: ids_qsnooc = 27
	59	INTEGER, PARAMETER :: ids_qraiic = 28
	60	INTEGER, PARAMETER :: ids_qsnoic = 29
	61	INTEGER, PARAMETER :: maxsend = 29 ! Maximum number of fields to send
[1279]	62
	63	! Id for fields received from ocean
	64	INTEGER, PARAMETER :: idr_sisutw = 1
	65	INTEGER, PARAMETER :: idr_icecov = 2
	66	INTEGER, PARAMETER :: idr_icealw = 3
	67	INTEGER, PARAMETER :: idr_icetem = 4
	68	INTEGER, PARAMETER :: idr_curenx = 5
	69	INTEGER, PARAMETER :: idr_cureny = 6
	70	INTEGER, PARAMETER :: idr_curenz = 7
	71	INTEGER, PARAMETER :: idr_oceco2 = 8
	72	INTEGER, PARAMETER :: maxrecv = 8 ! Maximum number of fields to receive
	73
[782]	74
[1279]	75	TYPE, PUBLIC :: FLD_CPL ! Type for coupling field information
	76	CHARACTER(len = 8) :: name ! Name of the coupling field
	77	LOGICAL :: action ! To be exchanged or not
	78	INTEGER :: nid ! Id of the field
	79	END TYPE FLD_CPL
[782]	80
[1279]	81	TYPE(FLD_CPL), DIMENSION(maxsend), SAVE, PUBLIC :: infosend ! Information for sending coupling fields
[2916]	82	!$OMP THREADPRIVATE(infosend)
[1279]	83	TYPE(FLD_CPL), DIMENSION(maxrecv), SAVE, PUBLIC :: inforecv ! Information for receiving coupling fields
[2916]	84	!$OMP THREADPRIVATE(inforecv)
[1279]	85
	86	LOGICAL,SAVE :: cpl_current
	87	!$OMP THREADPRIVATE(cpl_current)
[782]	88
	89	#ifdef CPP_COUPLE
	90
	91	CONTAINS
	92
	93	SUBROUTINE inicma
	94	!************************************************************************************
	95	!**** INICMA - Initialize coupled mode communication for atmosphere
	96	! and exchange some initial information with Oasis
	97	!
	98	! Rewrite to take the PRISM/psmile library into account
	99	! LF 09/2003
	100	!
[1067]	101	USE IOIPSL
[996]	102	USE surface_data, ONLY : version_ocean
[1279]	103	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
[2054]	104	#ifdef CPP_XIOS
	105	USE wxios, ONLY : wxios_context_init
	106	#endif
[2311]	107	USE print_control_mod, ONLY: lunout
[2371]	108	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
[1279]	109
[782]	110	! Local variables
	111	!************************************************************************************
	112	INTEGER :: comp_id
	113	INTEGER :: ierror, il_commlocal
	114	INTEGER :: il_part_id
	115	INTEGER, DIMENSION(3) :: ig_paral
	116	INTEGER, DIMENSION(2) :: il_var_nodims
	117	INTEGER, DIMENSION(4) :: il_var_actual_shape
	118	INTEGER :: il_var_type
	119	INTEGER :: jf
	120	CHARACTER (len = 6) :: clmodnam
	121	CHARACTER (len = 20) :: modname = 'inicma'
	122	CHARACTER (len = 80) :: abort_message
[1997]	123	LOGICAL, SAVE :: cpl_current_omp
[782]	124
	125	!* 1. Initializations
	126	! ---------------
	127	!************************************************************************************
[1279]	128	WRITE(lunout,*) ' '
	129	WRITE(lunout,*) ' '
	130	WRITE(lunout,*) ' ROUTINE INICMA'
	131	WRITE(lunout,) ' *************'
	132	WRITE(lunout,*) ' '
	133	WRITE(lunout,*) ' '
[782]	134
	135	!
	136	! Define the model name
	137	!
[2054]	138	clmodnam = 'LMDZ' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
[1067]	139
[1279]	140
[782]	141	!************************************************************************************
[1067]	142	! Define if coupling ocean currents or not
	143	!************************************************************************************
	144	!$OMP MASTER
	145	cpl_current_omp = .FALSE.
	146	CALL getin('cpl_current', cpl_current_omp)
	147	!$OMP END MASTER
	148	!$OMP BARRIER
	149	cpl_current = cpl_current_omp
[1279]	150	WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current
[1067]	151
	152	!************************************************************************************
[1279]	153	! Define coupling variables
	154	!************************************************************************************
	155
	156	! Atmospheric variables to send
	157
	158	!$OMP MASTER
	159	infosend(:)%action = .FALSE.
	160
	161	infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU'
	162	infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU'
	163	infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU'
	164	infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV'
	165	infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV'
	166	infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV'
	167	infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP'
	168	infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE'
	169	infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE'
	170	infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT'
	171	infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
	172
	173	IF (version_ocean=='nemo') THEN
	174	infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
	175	infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX'
	176	infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI'
	177	infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO'
	178	infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA'
	179	infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP'
	180	infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN'
	181	infosend(ids_taumod)%action = .TRUE. ; infosend(ids_taumod)%name = 'COTAUMOD'
	182	IF (carbon_cycle_cpl) THEN
	183	infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2'
	184	ENDIF
[2872]	185	infosend(ids_qraioc)%action = .TRUE. ; infosend(ids_qraioc)%name = 'COQRAIOC'
	186	infosend(ids_qsnooc)%action = .TRUE. ; infosend(ids_qsnooc)%name = 'COQSNOOC'
	187	infosend(ids_qraiic)%action = .TRUE. ; infosend(ids_qraiic)%name = 'COQRAIIC'
	188	infosend(ids_qsnoic)%action = .TRUE. ; infosend(ids_qsnoic)%name = 'COQSNOIC'
[1279]	189
	190	ELSE IF (version_ocean=='opa8') THEN
	191	infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE'
	192	infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE'
	193	infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE'
	194	infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE'
	195	infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU'
	196	infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU'
	197	infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA'
	198	infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU'
	199	ENDIF
	200
	201	! Oceanic variables to receive
	202
	203	inforecv(:)%action = .FALSE.
	204
	205	inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW'
	206	inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV'
	207	inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
	208	inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
	209
	210	IF (cpl_current ) THEN
	211	inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX'
	212	inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY'
	213	inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ'
	214	ENDIF
	215
	216	IF (carbon_cycle_cpl ) THEN
	217	inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
	218	ENDIF
	219
	220	!************************************************************************************
[782]	221	! Here we go: psmile initialisation
	222	!************************************************************************************
	223	IF (is_sequential) THEN
	224	CALL prism_init_comp_proto (comp_id, clmodnam, ierror)
	225
	226	IF (ierror .NE. PRISM_Ok) THEN
	227	abort_message=' Probleme init dans prism_init_comp '
[2311]	228	CALL abort_physic(modname,abort_message,1)
[782]	229	ELSE
[1279]	230	WRITE(lunout,*) 'inicma : init psmile ok '
[782]	231	ENDIF
	232	ENDIF
	233
	234	CALL prism_get_localcomm_proto (il_commlocal, ierror)
	235	!************************************************************************************
	236	! Domain decomposition
	237	!************************************************************************************
	238	ig_paral(1) = 1 ! apple partition for //
[2346]	239	ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1 ! offset
	240	ig_paral(3) = (jj_endnbp_lon+ii_end) - (jj_beginnbp_lon+ii_begin) + 1
[782]	241
[2346]	242	IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
[1279]	243	WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
[782]	244
	245	ierror=PRISM_Ok
	246	CALL prism_def_partition_proto (il_part_id, ig_paral, ierror)
	247
	248	IF (ierror .NE. PRISM_Ok) THEN
	249	abort_message=' Probleme dans prism_def_partition '
[2311]	250	CALL abort_physic(modname,abort_message,1)
[782]	251	ELSE
[1279]	252	WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
[782]	253	ENDIF
	254
	255	il_var_nodims(1) = 2
	256	il_var_nodims(2) = 1
	257
	258	il_var_actual_shape(1) = 1
[2346]	259	il_var_actual_shape(2) = nbp_lon
[782]	260	il_var_actual_shape(3) = 1
[2346]	261	il_var_actual_shape(4) = nbp_lat
[782]	262
	263	il_var_type = PRISM_Real
	264
	265	!************************************************************************************
[1279]	266	! Oceanic Fields to receive
	267	! Loop over all possible variables
[782]	268	!************************************************************************************
[1279]	269	DO jf=1, maxrecv
	270	IF (inforecv(jf)%action) THEN
	271	CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, &
	272	il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
	273	ierror)
	274	IF (ierror .NE. PRISM_Ok) THEN
	275	WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
	276	inforecv(jf)%name
	277	abort_message=' Problem in call to prism_def_var_proto for fields to receive'
[2311]	278	CALL abort_physic(modname,abort_message,1)
[1279]	279	ENDIF
[782]	280	ENDIF
	281	END DO
[1279]	282
[782]	283	!************************************************************************************
[1279]	284	! Atmospheric Fields to send
	285	! Loop over all possible variables
[782]	286	!************************************************************************************
[1279]	287	DO jf=1,maxsend
	288	IF (infosend(jf)%action) THEN
	289	CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, &
	290	il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
	291	ierror)
	292	IF (ierror .NE. PRISM_Ok) THEN
	293	WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
	294	infosend(jf)%name
	295	abort_message=' Problem in call to prism_def_var_proto for fields to send'
[2311]	296	CALL abort_physic(modname,abort_message,1)
[1279]	297	ENDIF
[782]	298	ENDIF
	299	END DO
[1279]	300
[782]	301	!************************************************************************************
	302	! End definition
	303	!************************************************************************************
	304	CALL prism_enddef_proto(ierror)
	305	IF (ierror .NE. PRISM_Ok) THEN
[1279]	306	abort_message=' Problem in call to prism_endef_proto'
[2311]	307	CALL abort_physic(modname,abort_message,1)
[782]	308	ELSE
[1279]	309	WRITE(lunout,*) 'inicma : endef psmile ok '
[782]	310	ENDIF
[1279]	311
[2054]	312	#ifdef CPP_XIOS
	313	CALL wxios_context_init()
	314	#endif
	315
[1279]	316	!$OMP END MASTER
[782]	317
	318	END SUBROUTINE inicma
	319
	320	!
	321	!************************************************************************************
	322	!
	323
	324	SUBROUTINE fromcpl(ktime, tab_get)
	325	! ======================================================================
	326	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
	327	! and Sea-Ice provided by the coupler. Adaptation to psmile library
	328	!======================================================================
	329	!
[2311]	330	USE print_control_mod, ONLY: lunout
[2371]	331	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
[782]	332	! Input arguments
	333	!************************************************************************************
	334	INTEGER, INTENT(IN) :: ktime
	335
	336	! Output arguments
	337	!************************************************************************************
[2346]	338	REAL, DIMENSION(nbp_lon, jj_nb,maxrecv), INTENT(OUT) :: tab_get
[782]	339
	340	! Local variables
	341	!************************************************************************************
	342	INTEGER :: ierror, i
	343	INTEGER :: istart,iend
	344	CHARACTER (len = 20) :: modname = 'fromcpl'
	345	CHARACTER (len = 80) :: abort_message
[2346]	346	REAL, DIMENSION(nbp_lon*jj_nb) :: field
[782]	347
	348	!************************************************************************************
[1279]	349	WRITE (lunout,*) ' '
	350	WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
	351	WRITE (lunout,*) ' '
[782]	352
	353	istart=ii_begin
[2429]	354	IF (is_south_pole_dyn) THEN
[2346]	355	iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
[782]	356	ELSE
[2346]	357	iend=(jj_end-jj_begin)*nbp_lon+ii_end
[782]	358	ENDIF
	359
[1279]	360	DO i = 1, maxrecv
[1965]	361	IF (inforecv(i)%action .AND. inforecv(i)%nid .NE. -1) THEN
[1279]	362	field(:) = -99999.
	363	CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
[2346]	364	tab_get(:,:,i) = RESHAPE(field(:),(/nbp_lon,jj_nb/))
[782]	365
[1279]	366	IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
	367	ierror.NE.PRISM_FromRest &
	368	.AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
	369	.AND. ierror.NE.PRISM_FromRestOut) THEN
	370	WRITE (lunout,*) 'Error with receiving filed : ', inforecv(i)%name, ktime
	371	abort_message=' Problem in prism_get_proto '
[2311]	372	CALL abort_physic(modname,abort_message,1)
[1279]	373	ENDIF
	374	ENDIF
[782]	375	END DO
	376
	377
	378	END SUBROUTINE fromcpl
	379
	380	!
	381	!************************************************************************************
	382	!
	383
	384	SUBROUTINE intocpl(ktime, last, tab_put)
	385	! ======================================================================
	386	! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
	387	! atmospheric coupling fields to the coupler with the psmile library.
	388	! IF last time step, writes output fields to binary files.
	389	! ======================================================================
	390	!
	391	!
[2311]	392	USE print_control_mod, ONLY: lunout
[2371]	393	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
[782]	394	! Input arguments
	395	!************************************************************************************
[1279]	396	INTEGER, INTENT(IN) :: ktime
	397	LOGICAL, INTENT(IN) :: last
[2346]	398	REAL, DIMENSION(nbp_lon, jj_nb, maxsend), INTENT(IN) :: tab_put
[782]	399
	400	! Local variables
	401	!************************************************************************************
[987]	402	LOGICAL :: checkout
	403	INTEGER :: istart,iend
	404	INTEGER :: wstart,wend
	405	INTEGER :: ierror, i
[2346]	406	REAL, DIMENSION(nbp_lon*jj_nb) :: field
[987]	407	CHARACTER (len = 20),PARAMETER :: modname = 'intocpl'
	408	CHARACTER (len = 80) :: abort_message
[782]	409
	410	!************************************************************************************
[987]	411	checkout=.FALSE.
[782]	412
[1279]	413	WRITE(lunout,*) ' '
	414	WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
	415	WRITE(lunout,*) 'last = ', last
	416	WRITE(lunout,*)
[782]	417
	418
	419	istart=ii_begin
[2429]	420	IF (is_south_pole_dyn) THEN
[2346]	421	iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
[782]	422	ELSE
[2346]	423	iend=(jj_end-jj_begin)*nbp_lon+ii_end
[782]	424	ENDIF
	425
	426	IF (checkout) THEN
	427	wstart=istart
	428	wend=iend
[2429]	429	IF (is_north_pole_dyn) wstart=istart+nbp_lon-1
	430	IF (is_south_pole_dyn) wend=iend-nbp_lon+1
[782]	431
[1279]	432	DO i = 1, maxsend
	433	IF (infosend(i)%action) THEN
[2346]	434	field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
[1279]	435	CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
	436	END IF
	437	END DO
	438	END IF
	439
[782]	440	!************************************************************************************
	441	! PRISM_PUT
	442	!************************************************************************************
	443
[1279]	444	DO i = 1, maxsend
[1965]	445	IF (infosend(i)%action .AND. infosend(i)%nid .NE. -1 ) THEN
[2346]	446	field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
[1279]	447	CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
	448
	449	IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
	450	.AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
	451	ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
	452	WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime
	453	abort_message=' Problem in prism_put_proto '
[2311]	454	CALL abort_physic(modname,abort_message,1)
[1279]	455	ENDIF
	456	ENDIF
[782]	457	END DO
	458
	459	!************************************************************************************
	460	! Finalize PSMILE for the case is_sequential, if parallel finalization is done
	461	! from Finalize_parallel in dyn3dpar/parallel.F90
	462	!************************************************************************************
	463
	464	IF (last) THEN
	465	IF (is_sequential) THEN
	466	CALL prism_terminate_proto(ierror)
	467	IF (ierror .NE. PRISM_Ok) THEN
[1279]	468	abort_message=' Problem in prism_terminate_proto '
[2311]	469	CALL abort_physic(modname,abort_message,1)
[782]	470	ENDIF
	471	ENDIF
	472	ENDIF
	473
	474
	475	END SUBROUTINE intocpl
	476
	477	#endif
	478
	479	END MODULE oasis

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

Download in other formats:

Original Format