Context Navigation

oasis.F90 @ 2523

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

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

Download in other formats:

Original Format