Context Navigation

oasis.F90 @ 5423

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

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

Download in other formats:

Original Format