New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

cpl_oasis4.F90 in branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis4.F90 @ 2113

Last change on this file since 2113 was 1715, checked in by smasson, 15 years ago
move daymod public variables in dom_oce, see ticket:590
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 45.2 KB

Line
1	MODULE cpl_oasis4
2	!!======================================================================
3	!! * MODULE cpl_oasis4 *
4	!! Coupled O/A : coupled ocean-atmosphere case using OASIS4
5	!! special case: OPA/LIM coupled to ECHAM5
6	!!=====================================================================
7	!! History :
8	!! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code
9	!! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision
10	!! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing
11	!! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision
12	!! " " ! 05-09 (R. Redler) extended to allow for communication over root only
13	!! " " ! 05-09 (R. Redler) extended to allow for communication over root only
14	!! " " ! 05-12 (R. Hill, Met. Office) Tweaks and hacks to get NEMO/O4 working
15	!! " " ! 06-02 (R. Redler, W. Park) Bug fixes and updates according to the OASIS3 interface
16	!! " " ! 06-02 (R. Redler) app/grid/grid_name from namelist
17	!!----------------------------------------------------------------------
18	#if defined key_oasis4
19	!!----------------------------------------------------------------------
20	!! 'key_oasis4' coupled Ocean/Atmosphere via OASIS4
21	!!----------------------------------------------------------------------
22	!! cpl_prism_init : initialization of coupled mode communication
23	!! cpl_prism_define : definition of grid and fields
24	!! cpl_prism_send : send out fields in coupled mode
25	!! cpl_prism_recv : receive fields in coupled mode
26	!! cpl_prism_finalize : finalize the coupled mode communication
27	!!----------------------------------------------------------------------
28	!! * Modules used
29	!##################### WARNING coupled mode ###############################
30	!##################### WARNING coupled mode ###############################
31	! Following line must be enabled if coupling with OASIS
32	! USE prism ! prism module
33	!##################### WARNING coupled mode ###############################
34	!##################### WARNING coupled mode ###############################
35	#if defined key_mpp_mpi
36	USE lib_mpp, only : mppsize, mpprank ! message passing
37	USE lib_mpp, only : mppsend ! message passing
38	USE lib_mpp, only : mpprecv ! message passing
39	#endif
40	USE dom_oce ! ocean space and time domain
41	USE in_out_manager ! I/O manager
42	USE par_oce !
43	USE phycst, only : rt0 ! freezing point of sea water
44	USE oasis4_date ! OASIS4 date declarations in
45	! PRISM compatible format
46	IMPLICIT NONE
47	!
48	! Exchange parameters for coupling ORCA-LIM with ECHAM5
49	!
50	#if defined key_cpl_ocevel
51	INTEGER, PARAMETER :: nsend = 6
52	#else
53	INTEGER, PARAMETER :: nsend = 4
54	#endif
55
56	#if defined key_cpl_discharge
57	INTEGER, PARAMETER :: nrecv = 20
58	#else
59	INTEGER, PARAMETER :: nrecv = 17
60	#endif
61
62	INTEGER, DIMENSION(nsend) :: send_id
63	INTEGER, DIMENSION(nrecv) :: recv_id
64
65	CHARACTER(len=32) :: cpl_send (nsend)
66	CHARACTER(len=32) :: cpl_recv (nrecv)
67
68	CHARACTER(len=16) :: app_name ! application name for OASIS use
69	CHARACTER(len=16) :: comp_name ! name of this PRISM component
70	CHARACTER(len=16) :: grid_name ! name of the grid
71	CHARACTER(len=1) :: c_mpi_send
72
73	! The following now come in via new module oasis4_date
74	! TYPE(PRISM_Time_struct), PUBLIC :: dates ! date info for send operation
75	! TYPE(PRISM_Time_struct), PUBLIC :: dates_bound(2) ! date info for send operation
76	! TYPE(PRISM_Time_struct), PUBLIC :: dater ! date info for receive operation
77	! TYPE(PRISM_Time_struct), PUBLIC :: dater_bound(2) ! date info for receive operation
78	! TYPE(PRISM_Time_struct), PUBLIC :: tmpdate
79
80	PRIVATE
81
82	INTEGER, PARAMETER :: localRoot = 0
83
84	INTEGER :: localRank ! local MPI rank
85	INTEGER :: localSize ! local MPI size
86	INTEGER :: localComm ! local MPI size
87	LOGICAL :: commRank ! true for ranks doing OASIS communication
88	INTEGER :: comp_id ! id returned by prism_init_comp
89
90	INTEGER :: range(5)
91
92	LOGICAL, SAVE :: prism_was_initialized
93	LOGICAL, SAVE :: prism_was_terminated
94	INTEGER, SAVE :: write_grid
95
96	INTEGER :: ierror ! return error code
97
98	#ifdef key_cpl_rootexchg
99	LOGICAL :: rootexchg =.true. ! logical switch
100	#else
101	LOGICAL :: rootexchg =.false. ! logical switch
102	#endif
103
104	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for exchange
105	REAL(wp), DIMENSION(:), ALLOCATABLE :: buffer ! Temporary buffer for exchange
106	INTEGER, DIMENSION(:,:), ALLOCATABLE :: ranges ! Temporary buffer for exchange
107
108	DOUBLE PRECISION :: date_incr
109
110	!! Routine accessibility
111	PUBLIC cpl_prism_init
112	PUBLIC cpl_prism_define
113	PUBLIC cpl_prism_send
114	PUBLIC cpl_prism_recv
115	PUBLIC cpl_prism_finalize
116
117	PUBLIC send_id, recv_id
118
119	!!----------------------------------------------------------------------
120	!! OPA 9.0 , LOCEAN-IPSL (2006)
121	!! $Id$
122	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
123	!!----------------------------------------------------------------------
124
125	CONTAINS
126
127	SUBROUTINE cpl_prism_init( localCommunicator )
128
129	IMPLICIT NONE
130
131	!!-------------------------------------------------------------------
132	!! * ROUTINE cpl_prism_init *
133	!!
134	!! ** Purpose : Initialize coupled mode communication for ocean
135	!! exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
136	!!
137	!! ** Method : OASIS4 MPI communication
138	!!--------------------------------------------------------------------
139	!! * Arguments
140	!!
141	INTEGER, INTENT(OUT) :: localCommunicator
142	!!
143	!! * Local declarations
144	!!
145
146	NAMELIST/nam_mpp/ app_name, comp_name, c_mpi_send, grid_name
147
148	!!
149	!!--------------------------------------------------------------------
150	!!
151	IF(lwp) WRITE(numout,*)
152	IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'
153	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
154	IF(lwp) WRITE(numout,*)
155
156	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily \|\| defined key_flx_forced_daily
157
158	#if !defined key_oasis4
159	! The following is not necessarily a valid peice of checking
160
161	IF(lwp) WRITE(numout,cform_err)
162	IF(lwp) WRITE(numout,) ' key_coupled and key_flx_bulk_ key_flx_forced_daily are incompatible'
163	nstop = nstop + 1
164
165	#endif
166
167	#endif
168
169	REWIND( numnam )
170	READ ( numnam, nam_mpp )
171	REWIND( numnam )
172
173	!------------------------------------------------------------------
174	! 1st Initialize the PRISM system for the application
175	!------------------------------------------------------------------
176
177	CALL prism_initialized (prism_was_initialized, ierror)
178	IF ( ierror /= PRISM_Success ) &
179	CALL prism_abort( comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_initialized' )
180
181	IF ( .NOT. prism_was_initialized ) THEN
182	CALL prism_init( app_name, ierror )
183	IF ( ierror /= PRISM_Success ) &
184	CALL prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init')
185	prism_was_initialized = .true.
186	ELSE
187	call prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Do not initialize prism twice!')
188	ENDIF
189	!
190	! Obtain the actual dates and date bounds
191	!
192	! date is determined by adding days since beginning of
193	! the run to the corresponding initial date. Note that
194	! OPA internal info about the start date of the experiment
195	! is bypassed. Instead we rely sololy on the info provided
196	! by the SCC.xml file.
197	!
198	dates = PRISM_Jobstart_date
199
200	WRITE(6,*) "PRISM JOB START DATE IS", dates
201
202	!
203	! upper bound is determined by adding half a time step
204	!
205	tmpdate = dates
206	date_incr = rdttra(1)/2.0
207	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
208	dates_bound(2) = tmpdate
209	!
210	! lower bound is determined by half distance to date from previous run
211	!
212	tmpdate = dates
213	date_incr = ( adatrj - adatrj0 ) * 43200.0
214	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
215	dates_bound(1) = tmpdate
216
217	dater = dates
218	dater_bound(1) = dates_bound(1)
219	dater_bound(2) = dates_bound(2)
220
221	WRITE(6,*) "DATE send and rec BOUNDS",dater_bound
222	WRITE(6,*) "OTHER BITS FOR DATE",rdttra(1)
223	WRITE(6,*) "adatrj/0",adatrj,adatrj0,date_incr
224
225	!------------------------------------------------------------------
226	! 2nd Initialize the PRISM system for the component
227	!------------------------------------------------------------------
228
229	CALL prism_init_comp ( comp_id, comp_name, ierror )
230	IF ( ierror /= PRISM_Success ) &
231	CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init_comp')
232
233	WRITE(6,*) "COMPLETED INIT_COMP",comp_name,comp_id
234
235	!------------------------------------------------------------------
236	! 3rd Get an MPI communicator for OPA local communication
237	!------------------------------------------------------------------
238
239	CALL prism_get_localcomm ( comp_id, localComm, ierror )
240	IF ( ierror /= PRISM_Success ) &
241	CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_get_localcomm' )
242
243	localCommunicator = localComm
244
245	WRITE(6,*) "COMPLETED GET_LOCALCOMM",comp_name,comp_id
246
247
248	END SUBROUTINE cpl_prism_init
249
250
251	SUBROUTINE cpl_prism_define ()
252
253	IMPLICIT NONE
254
255	!!-------------------------------------------------------------------
256	!! * ROUTINE cpl_prism_define *
257	!!
258	!! ** Purpose : Define grid and field information for ocean
259	!! exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
260	!!
261	!! ** Method : OASIS4 MPI communication
262	!!--------------------------------------------------------------------
263	!! * Arguments
264	!!
265	!! * Local declarations
266
267	INTEGER :: grid_id(2) ! id returned by prism_def_grid
268
269	INTEGER :: upoint_id(2), &
270	vpoint_id(2), &
271	tpoint_id(2), &
272	fpoint_id(2) ! ids returned by prism_set_points
273
274	INTEGER :: umask_id(2), &
275	vmask_id(2), &
276	tmask_id(2), &
277	fmask_id(2) ! ids returned by prism_set_mask
278
279	INTEGER :: grid_type ! PRISM grid type
280
281	INTEGER :: shape(2,3) ! shape of arrays passed to PSMILe
282	INTEGER :: nodim(2)
283	INTEGER :: data_type ! data type of transients
284
285	INTEGER :: nbr_corners
286
287	LOGICAL :: new_points
288	LOGICAL :: new_mask
289	LOGICAL :: mask(jpi,jpj,jpk)
290
291	INTEGER :: ji, jj, jk ! local loop indicees
292
293	CHARACTER(len=32) :: cpl_send (nsend)
294	CHARACTER(len=32) :: cpl_recv (nrecv)
295
296	CHARACTER(len=32) :: grid_name ! name of the grid
297	CHARACTER(len=32) :: point_name ! name of the grid points
298
299	REAL(kind=wp), ALLOCATABLE :: rclon(:,:,:)
300	REAL(kind=wp), ALLOCATABLE :: rclat(:,:,:)
301	REAL(kind=wp), ALLOCATABLE :: rcz (:,:)
302
303	!!--------------------------------------------------------------------
304
305	IF(lwp) WRITE(numout,*)
306	IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
307	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
308	IF(lwp) WRITE(numout,*)
309
310	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily \|\| defined key_flx_forced_daily
311
312	#if !defined key_oasis4
313	! The problem with the following is that it ASSUMES we're only ever coupling to an atmosphere
314	! which is not necessarily the case. Prevent this test temporarily for NEMOGAM development.
315
316	IF(lwp) WRITE(numout,cform_err)
317	IF(lwp) WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible'
318	nstop = nstop + 1
319
320	#endif
321
322	#endif
323
324	! -----------------------------------------------------------------
325	! ... Some initialisation
326	! -----------------------------------------------------------------
327
328	send_id = 0
329	recv_id = 0
330
331	#if defined key_mpp_mpi
332
333	! -----------------------------------------------------------------
334	! ... Some MPI stuff relevant for optional exchange via root only
335	! -----------------------------------------------------------------
336
337	commRank = .false.
338
339	localRank = mpprank ! from lib_mpp
340	localSize = mppsize ! from lib_mpp
341
342	IF(lwp) WRITE(numout,*) "CALLING DEFINE"
343
344	IF ( rootexchg ) THEN
345	IF ( localRank == localRoot ) commRank = .true.
346	ELSE
347	commRank = .true.
348	ENDIF
349
350	#else
351	!
352	! For non-parallel configurations the one and only process ("localRoot")
353	! takes part in the communication
354	!
355	localRank = localRoot
356	commRank = .true.
357
358	#endif
359
360	! -----------------------------------------------------------------
361	! ... Allocate memory for data exchange
362	! -----------------------------------------------------------------
363
364
365	IF(lwp) WRITE(numout,*) "Abbout to allocate exfld",jpi,jpj
366
367	ALLOCATE(exfld(1:jpi,1:jpj), stat = ierror)
368	IF (ierror > 0) THEN
369	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Reals')
370	RETURN
371	ENDIF
372
373	IF ( rootexchg .and. localRank == localRoot ) THEN
374	ALLOCATE(ranges(5,0:localSize-1), stat = ierror)
375	IF (ierror > 0) THEN
376	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Integer')
377	RETURN
378	ENDIF
379	ENDIF
380
381	!------------------------------------------------------------------
382	! 1st Declare the local grid (ORCA tripolar) characteristics for
383	! surface coupling. The halo regions must be excluded. For
384	! surface coupling it is sufficient to specify only one
385	! vertical z-level.
386	!------------------------------------------------------------------
387
388	grid_type = PRISM_irrlonlat_regvrt
389
390	IF(lwp) WRITE(numout,*) "Set grid type"
391
392
393	! -----------------------------------------------------------------
394	! ... Define the shape of the valid region without the halo.
395	! For serial configuration (key_mpp_mpi not being active)
396	! nl* is set to the global values 1 and jp*glo.
397	! -----------------------------------------------------------------
398
399	IF ( rootexchg ) THEN
400	shape(1,1) = 1+jpreci
401	shape(2,1) = jpiglo-jpreci
402	shape(1,2) = 1+jpreci
403	shape(2,2) = jpjglo-jpreci
404	shape(1,3) = 1
405	shape(2,3) = 1
406	ELSE
407	shape(1,1) = 1+jpreci
408	shape(2,1) = jpi-jpreci
409	shape(1,2) = 1+jpreci
410	shape(2,2) = jpj-jpreci
411	shape(1,3) = 1
412	shape(2,3) = 1
413	ENDIF
414
415	IF(lwp) WRITE(numout,*) "commrank is", commRank
416
417	IF ( commRank ) THEN
418
419	IF(lwp) WRITE(numout,*) "CALLING DEF_GRID"
420
421	IF(lwp) WRITE(numout,*) "grid name",grid_name
422	IF(lwp) WRITE(numout,*) " shape",shape
423	IF(lwp) WRITE(numout,*) "grid type",grid_type
424
425	CALL prism_def_grid ( grid_id(1), grid_name, comp_id, shape, &
426	grid_type, ierror )
427	IF ( ierror /= PRISM_Success ) THEN
428	PRINT *, 'OPA cpl_prism_define: Failure in prism_def_grid'
429	CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_grid')
430	ENDIF
431
432	!------------------------------------------------------------------
433	! 2nd Declare the geometic information for this grid.
434	!------------------------------------------------------------------
435
436	! -----------------------------------------------------------------
437	! ... Redefine shape which may now include the halo region as well.
438	! -----------------------------------------------------------------
439
440	shape(1,1) = 1
441	shape(2,1) = jpi
442	shape(1,2) = 1
443	shape(2,2) = jpj
444	shape(1,3) = 1
445	shape(2,3) = 1
446
447	IF(lwp) WRITE(numout,*) "redefined shape",shape
448
449	! -----------------------------------------------------------------
450	! ... Define the elements, i.e. specify the corner points for each
451	! volume element. In case OPA runs on level coordinates (regular
452	! in the vertical) we only need to give the 4 horizontal corners
453	! for a volume element plus the vertical position of the upper
454	! and lower face. Nevertheless the volume element has 8 corners.
455	! -----------------------------------------------------------------
456
457	!
458	! ... Treat corners in the horizontal plane
459	!
460	ALLOCATE(rclon(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
461	STAT=ierror)
462	IF ( ierror /= 0 ) &
463	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
464
465	ALLOCATE(rclat(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
466	STAT=ierror)
467	IF ( ierror /= 0 ) &
468	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
469
470	nbr_corners = 8
471	!
472	! ... Set right longitudes and upper latitudes
473	!
474	DO jj = shape(1,2), shape(2,2)
475	DO ji = shape(1,1), shape(2,1)
476	rclon(ji,jj,1) = glamu(ji,jj)
477	rclon(ji,jj,2) = glamu(ji,jj)
478	rclat(ji,jj,2) = gphiv(ji,jj)
479	rclat(ji,jj,3) = gphiv(ji,jj)
480	ENDDO
481	ENDDO
482	!
483	! ... Set the lower latitudes
484	!
485	DO jj = shape(1,2)+1, shape(2,2)
486	DO ji = shape(1,1), shape(2,1)
487	rclat(ji,jj-1,1) = rclat(ji,jj,2)
488	rclat(ji,jj-1,4) = rclat(ji,jj,3)
489	ENDDO
490	ENDDO
491	!
492	! ... Set the left longitudes
493	!
494	DO jj = shape(1,2), shape(2,2)
495	DO ji = shape(1,1)+1, shape(2,1)
496	rclon(ji-1,jj,3) = rclon(ji,jj,2)
497	rclon(ji-1,jj,4) = rclon(ji,jj,1)
498	ENDDO
499	ENDDO
500	!
501	! ... Set the lowermost latitudes
502	!
503	DO jj = shape(1,2), shape(1,2)
504	DO ji = shape(1,1), shape(2,1)
505	rclat(ji,jj,1) = 2.0*gphit(ji,jj)-rclat(ji,jj,2)
506	rclat(ji,jj,4) = 2.0*gphit(ji,jj)-rclat(ji,jj,4)
507	ENDDO
508	ENDDO
509	!
510	! ... Set the rightmost latitudes
511	!
512	DO jj = shape(1,2), shape(2,2)
513	DO ji = shape(1,2), shape(1,2)
514	rclon(ji,jj,3) = 2.0*glamt(ji,jj)-rclon(ji,jj,2)
515	rclon(ji,jj,4) = 2.0*glamt(ji,jj)-rclon(ji,jj,1)
516
517	WRITE(76,*) "rclon", ji, jj, rclon(ji,jj,1), &
518	rclon(ji,jj,2), &
519	rclon(ji,jj,3), &
520	rclon(ji,jj,4)
521
522	WRITE(76,*) "rclat", ji, jj, rclat(ji,jj,1), &
523	rclat(ji,jj,2), &
524	rclat(ji,jj,3), &
525	rclat(ji,jj,4)
526
527	ENDDO
528	ENDDO
529
530	!
531	! ... Treat corners along the vertical axis
532	!
533	ALLOCATE(rcz(shape(1,3):shape(2,3),2), STAT=ierror)
534	IF ( ierror /= 0 ) &
535	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rcz')
536
537	DO jk = shape(1,3), shape(2,3)
538	rcz(jk,1) = gdepw(jk)
539	rcz(jk,2) = gdepw(jk+1)
540	ENDDO
541
542	IF(lwp) WRITE(numout,*) "ABOUT TO CALL SET CORNERS",shape
543
544	CALL prism_set_corners ( grid_id(1), nbr_corners, shape, rclon, rclat, &
545	rcz, ierror)
546	IF ( ierror /= PRISM_Success ) &
547	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_corners')
548
549	DEALLOCATE(rclon, rclat, rcz)
550
551	! -----------------------------------------------------------------
552	! ... Define the gridpoints
553	! -----------------------------------------------------------------
554
555	new_points = .TRUE.
556
557	IF(lwp) WRITE(numout,*) "CALLING SET_POINTS"
558
559	!
560	! ... the u-points
561	!
562	point_name = 'u-points'
563	CALL prism_set_points ( upoint_id(1), point_name, grid_id(1), shape, &
564	glamu, gphiu, gdept(shape(1,3):shape(2,3)), new_points, ierror )
565	IF ( ierror /= PRISM_Success ) &
566	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points upoint_id')
567	!
568	! ... the v-points
569	!
570
571	IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done u doing v"
572
573	point_name = 'v-points'
574	CALL prism_set_points ( vpoint_id(1), point_name, grid_id(1), shape, &
575	glamv, gphiv, gdept(shape(1,3):shape(2,3)), new_points, ierror )
576	IF ( ierror /= PRISM_Success ) &
577	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points vpoint_id')
578	!
579	! ... the t-points
580	!
581	! WRITE(76,*) 'CALLING T POINTS', shape
582	! WRITE(77,*) 'glamt', glamt
583	! WRITE(78,*) 'gphit', gphit
584	!
585	point_name = 't-points'
586	CALL prism_set_points ( tpoint_id(1), point_name, grid_id(1), shape, &
587	glamt, gphit, gdept(shape(1,3):shape(2,3)), new_points, ierror )
588	IF ( ierror /= PRISM_Success ) &
589	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points tpoint_id')
590	!
591	! ... the f-points
592	!
593	point_name = 'f-points'
594	CALL prism_set_points ( fpoint_id(1), point_name, grid_id(1), shape, &
595	glamf, gphif, gdept(shape(1,3):shape(2,3)), new_points, ierror )
596	IF ( ierror /= PRISM_Success ) &
597	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points fpoint_id')
598
599
600	IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done f"
601
602	! -----------------------------------------------------------------
603	! ... Convert OPA masks to logicals and define the masks
604	! -----------------------------------------------------------------
605
606	new_mask = .true.
607
608	mask = (umask == 1)
609	CALL prism_set_mask (umask_id(1), grid_id(1), shape, &
610	mask(shape(1,1):shape(2,1), &
611	shape(1,2):shape(2,2), &
612	shape(1,3):shape(2,3)), &
613	new_mask, ierror )
614	IF ( ierror /= PRISM_Success ) &
615	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
616
617	mask = (vmask == 1)
618	CALL prism_set_mask (vmask_id(1), grid_id(1), shape, &
619	mask(shape(1,1):shape(2,1), &
620	shape(1,2):shape(2,2), &
621	shape(1,3):shape(2,3)), &
622	new_mask, ierror )
623	IF ( ierror /= PRISM_Success ) &
624	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
625
626	mask = (tmask == 1)
627	CALL prism_set_mask (tmask_id(1), grid_id(1), shape, &
628	mask(shape(1,1):shape(2,1), &
629	shape(1,2):shape(2,2), &
630	shape(1,3):shape(2,3)), &
631	new_mask, ierror )
632	IF ( ierror /= PRISM_Success ) &
633	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
634
635	mask = (fmask == 1)
636	CALL prism_set_mask (fmask_id(1), grid_id(1), shape, &
637	mask(shape(1,1):shape(2,1), &
638	shape(1,2):shape(2,2), &
639	shape(1,3):shape(2,3)), &
640	new_mask, ierror )
641	IF ( ierror /= PRISM_Success ) &
642	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
643
644	IF(lwp) WRITE(numout,*) "DONE ALL THE SET MASKS"
645
646	! -----------------------------------------------------------------
647	! ... Define the angles
648	! This is needed if zonal tau is not oriented E-W and meridional
649	! tau is not oriented along N-S but rather along local coordinate
650	! axis. Please check!!!!
651	! -----------------------------------------------------------------
652
653	!rr cal prism_set_angles ( ..., ierror ) ! not yet supported by OASIS4
654
655	! -----------------------------------------------------------------
656	! ... Define the partition
657	! -----------------------------------------------------------------
658
659	IF ( rootexchg ) THEN
660
661	range(1) = nimpp-1+nldi ! global start in i
662	range(2) = nlei-nldi+1 ! local size in i of valid region
663	range(3) = njmpp-1+nldj ! global start in j
664	range(4) = nlej-nldj+1 ! local size in j of valid region
665	range(5) = range(2) &
666	* range(4) ! local horizontal size
667	!
668	! Collect ranges from all NEMO procs on the local root process
669	!
670	CALL mpi_gather(range, 5, MPI_INTEGER, &
671	ranges, 5, MPI_INTEGER, localRoot, localComm, ierror)
672
673	IF ( localRank == localRoot ) THEN
674
675	maxlen = maxval(ranges(5,:))
676
677	ALLOCATE(buffer(1:maxlen), stat = ierror)
678	IF (ierror > 0) THEN
679	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating buffer')
680	RETURN
681	ENDIF
682
683	ENDIF
684
685	ENDIF
686
687	! -----------------------------------------------------------------
688	! ... Define the scalefactors
689	! -----------------------------------------------------------------
690
691	!rr WRITE(numout,*) "CALLING SCALEFACTOR"
692	!rr call prism_set_scalefactor ( grid_id(1), shape, e1t, e2t, e3t, ierror ) ! not yet supported by OASIS4
693	!rr WRITE(numout,*) "ABOUT TO DEFINE THE TRANSIENTS"
694
695	!------------------------------------------------------------------
696	! 3rd Declare the transient variables
697	!------------------------------------------------------------------
698	!
699	! ... Define symbolic names for the transient fields send by the ocean
700	! These must be identical to the names specified in the SMIOC file.
701	!
702	cpl_send( 1)='SOSSTSST' ! sea surface temperature -> sst_io
703	cpl_send( 2)='SITOCEAN' ! sea ice thickness -> hicif (only 1 layer available!)
704	#if defined key_cpl_albedo
705	cpl_send( 3)='STIOCEAN' ! surface temperature over sea ice -> tn_ice
706	cpl_send( 4)='SAIOCEAN' ! albedo over sea ice -> alb_ice
707	#else
708	cpl_send( 3)='SITOCEAN' ! sea ice thickness -> hicif (only 1 layer available!)
709	cpl_send( 4)='SNTOCEAN' ! surface snow thickness over sea ice -> hsnif
710	#endif
711	#if defined key_cpl_ocevel
712	cpl_send( 5)='SUNOCEAN' ! U-velocity -> un
713	cpl_send( 6)='SVNOCEAN' ! V-velocity -> vn
714	#endif
715	!
716	! ... Define symbolic names for transient fields received by the ocean.
717	! These must be identical to the names specified in the SMIOC file.
718	!
719	! ... a) U-Grid fields
720	!
721	cpl_recv( 1)='TXWOCEWU' ! weighted surface downward eastward stress
722	cpl_recv( 2)='TYWOCEWU' ! weighted surface downward northward stress
723	cpl_recv( 3)='TXIOCEWU' ! weighted surface downward eastward stress over ice
724	cpl_recv( 4)='TYIOCEWU' ! weighted surface downward northward stress over ice
725	!
726	! ... a) V-Grid fields
727	!
728	cpl_recv( 5)='TXWOCEWV' ! weighted surface downward eastward stress
729	cpl_recv( 6)='TYWOCEWV' ! weighted surface downward northward stress
730	cpl_recv( 7)='TXIOCEWV' ! weighted surface downward eastward stress over ice
731	cpl_recv( 8)='TYIOCEWV' ! weighted surface downward northward stress over ice
732	!
733	! ... a) T-Grid fields
734	!
735	cpl_recv( 9)='FRWOCEPE' ! P-E over water -> zpew
736	cpl_recv(10)='FRIOCEPE' ! P-E over ice -> zpei
737	cpl_recv(11)='FRROCESN' ! surface downward snow fall -> zpsol
738	cpl_recv(12)='FRIOCEEV' ! surface upward snow flux where sea ice -> zevice
739
740	cpl_recv(13)='QSWOCESR' ! surface net downward shortwave flux -> qsr_oce
741	cpl_recv(14)='QSWOCENS' ! surface downward non-solar heat flux in air -> qnsr_oce
742	cpl_recv(15)='QSIOCESR' ! solar heat flux on sea ice -> qsr_ice
743	cpl_recv(16)='QSIOCENS' ! non-solar heat flux on sea ice -> qnsr_ice
744	cpl_recv(17)='QSIOCEDQ' ! non-solar heat flux derivative -> dqns_ice
745
746	#ifdef key_cpl_discharge
747	cpl_recv(18)='FRWOCEIS' ! ice discharge into ocean -> calving
748	cpl_recv(19)='FRWOCERD' ! river discharge into ocean -> zrunriv
749	cpl_recv(20)='FRWOCECD' ! continental discharge into ocean -> zruncot
750	#endif
751	IF ( wp == 4 ) data_type = PRISM_REAL
752	IF ( wp == 8 ) data_type = PRISM_DOUBLE_PRECISION
753
754	nodim(1) = 3 ! check
755	nodim(2) = 0
756	!
757	! ... Announce send variables, all on T points.
758	!
759	DO ji = 1, nsend
760	! if ( ji == 2 ) ; then ; nodim(2) = 2 ; else ; nodim(2) = 0 ; endif
761	CALL prism_def_var (send_id(ji), cpl_send(ji), grid_id(1), &
762	tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
763	IF ( ierror /= PRISM_Success ) THEN
764	PRINT *, 'Failed to define transient ', ji, TRIM(cpl_send(ji))
765	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
766	ENDIF
767	ENDDO
768	!
769	nodim(1) = 3 ! check
770	nodim(2) = 0
771	!
772	! ... Announce recv variables.
773	!
774	! ... a) on U points
775	!
776	DO ji = 1, 4
777	CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
778	upoint_id(1), umask_id(1), nodim, shape, data_type, ierror)
779	IF ( ierror /= PRISM_Success ) THEN
780	PRINT *, 'Failed to define transient ', ji, TRIM(cpl_recv(ji))
781	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
782	ENDIF
783	ENDDO
784	!
785	! ... b) on V points
786	!
787	DO ji = 5, 8
788	CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
789	vpoint_id(1), vmask_id(1), nodim, shape, data_type, ierror)
790	IF ( ierror /= PRISM_Success ) THEN
791	PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
792	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
793	ENDIF
794	ENDDO
795	!
796	! ... c) on T points
797	!
798	DO ji = 9, nrecv
799	CALL prism_def_var (recv_id(ji), "SORUNOFF", grid_id(1), &
800	tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
801	IF ( ierror /= PRISM_Success ) THEN
802	PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
803	CALL prism_abort ( comp_id, 'OPA9.0', 'OPA cpl_prism_define: Failure in prism_def_var')
804	ENDIF
805	ENDDO
806
807	ENDIF ! commRank
808
809	!------------------------------------------------------------------
810	! 4th End of definition phase
811	!------------------------------------------------------------------
812
813	IF(lwp) WRITE(numout,*) "ABOUT TO CALL PRISM_ENDDEF"
814
815	CALL prism_enddef(ierror)
816
817	IF(lwp) WRITE(numout,*) "DONE ENDDEF",ierror
818
819	IF ( ierror /= PRISM_Success ) &
820	CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_enddef')
821
822	IF(lwp) WRITE(numout,*) "ALL DONE, EXITING PRISM SET UP PHASE"
823
824	END SUBROUTINE cpl_prism_define
825
826
827
828	SUBROUTINE cpl_prism_send( var_id, date, data_array, info )
829
830	IMPLICIT NONE
831
832	!!---------------------------------------------------------------------
833	!! * ROUTINE cpl_prism_send *
834	!!
835	!! ** Purpose : - At each coupling time-step,this routine sends fields
836	!! like sst or ice cover to the coupler or remote application.
837	!!
838	!! ** Method : OASIS4
839	!!----------------------------------------------------------------------
840	!! * Arguments
841	!!
842	INTEGER, INTENT( IN ) :: var_id ! variable Id
843	INTEGER, INTENT( OUT ) :: info ! variable Id
844	INTEGER, INTENT( IN ) :: date ! ocean time-step in seconds
845	REAL(wp) :: data_array(:,:)
846	!!
847	!! * Local declarations
848	!!
849	#if defined key_mpp_mpi
850	REAL(wp) :: global_array(jpiglo,jpjglo)
851	!
852	!mpi INTEGER :: status(MPI_STATUS_SIZE)
853	!mpi INTEGER :: type ! MPI data type
854	INTEGER :: request ! MPI isend request
855	INTEGER :: ji, jj, jn ! local loop indicees
856	#else
857	INTEGER :: ji
858	#endif
859	!!
860	INTEGER, SAVE :: ncount = 0
861	!!
862	!!--------------------------------------------------------------------
863	!!
864	ncount = ncount + 1
865
866	#if defined key_mpp_mpi
867
868	request = 0
869
870	IF ( rootexchg ) THEN
871	!
872	!mpi IF ( wp == 4 ) type = MPI_REAL
873	!mpi IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
874	!
875	! collect data on the local root process
876	!
877	IF ( localRank /= localRoot ) THEN
878
879	DO jj = nldj, nlej
880	DO ji = nldi, nlei
881	exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj)
882	ENDDO
883	ENDDO
884
885	!mpi CALL mpi_send(exfld, range(5), type, localRoot, localRank, localComm, ierror)
886	CALL mppsend (localRank, exfld, range(5), localRoot, request)
887	ENDIF
888
889	IF ( localRank == localRoot ) THEN
890
891	DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
892	DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
893	global_array(ji,jj) = data_array(ji,jj) ! workaround
894	ENDDO
895	ENDDO
896
897	DO jn = 1, localSize-1
898
899	!mpi CALL mpi_recv(buffer, ranges(5,jn), type, localRoot, jn, localComm, status, ierror)
900	CALL mpprecv(jn, buffer, ranges(5,jn))
901
902	DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
903	DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
904	global_array(ji,jj) = buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 )
905	ENDDO
906	ENDDO
907
908	ENDDO
909
910	ENDIF
911	!
912	! send data from local root to OASIS4
913	!
914	CALL prism_put ( var_id, dates, dates_bound, global_array, info, ierror )
915
916	ELSE
917	!
918	! send local data from every process to OASIS4
919	!
920	CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )
921
922	ENDIF !rootexchg
923
924	#else
925
926	!
927	! send local data from every process to OASIS4
928	!
929	IF ( commRank ) &
930	CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )
931
932	#endif
933
934	IF ( commRank ) THEN
935
936	IF (l_ctl) THEN
937
938	IF ( info==PRISM_Cpl ) THEN
939	WRITE(numout,) '***************'
940	DO ji = 1, nsend
941	IF (var_id == send_id(ji) ) THEN
942	WRITE(numout,*) 'prism_put_proto: Outgoing ', cpl_send(ji)
943	EXIT
944	ENDIF
945	ENDDO
946	WRITE(numout,*) 'prism_put: var_id ', var_id
947	WRITE(numout,*) 'prism_put: date ', date
948	WRITE(numout,*) 'prism_put: info ', info
949	WRITE(numout,*) ' - Minimum value is ', MINVAL(data_array)
950	WRITE(numout,*) ' - Maximum value is ', MAXVAL(data_array)
951	WRITE(numout,*) ' - Sum value is ', SUM(data_array)
952	WRITE(numout,) '***************'
953	ENDIF
954
955	ENDIF
956
957	IF ( ncount == nrecv ) THEN
958	!
959	! 3. Update dates and dates_bound for next step. We assume that cpl_prism_send
960	! is called for all send fields at each time step. Therefore we update
961	! the date argument to prism_put only every nsend call to cpl_prism_send.
962	!
963	dates_bound(1) = dates_bound(2)
964
965	tmpdate = dates_bound(2)
966	date_incr = rdCplttra(1)/2.0
967
968	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
969	dates = tmpdate
970	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
971	dates_bound(2) = tmpdate
972
973	ncount = 0
974
975	ENDIF
976
977	ENDIF ! commRank
978
979	END SUBROUTINE cpl_prism_send
980
981
982
983	SUBROUTINE cpl_prism_recv( var_id, date, data_array, info )
984
985	IMPLICIT NONE
986
987	!!---------------------------------------------------------------------
988	!! * ROUTINE cpl_prism_recv *
989	!!
990	!! ** Purpose : - At each coupling time-step,this routine receives fields
991	!! like stresses and fluxes from the coupler or remote application.
992	!!
993	!! ** Method : OASIS4
994	!!----------------------------------------------------------------------
995	!! * Arguments
996	!!
997	INTEGER, INTENT( IN ) :: var_id ! variable Id
998	INTEGER, INTENT( OUT ) :: info ! variable Id
999	INTEGER, INTENT( IN ) :: date ! ocean time-step in seconds
1000	REAL(wp),INTENT( OUT ) :: data_array(:,:)
1001	!!
1002	!! * Local declarations
1003	!!
1004	#if defined key_mpp_mpi
1005	REAL(wp) :: global_array(jpiglo,jpjglo)
1006	!
1007	LOGICAL :: action = .false.
1008	!mpi INTEGER :: status(MPI_STATUS_SIZE)
1009	!mpi INTEGER :: type ! MPI data type
1010	INTEGER :: request ! MPI isend request
1011	INTEGER :: ji, jj, jn ! local loop indicees
1012	#else
1013	INTEGER :: ji
1014	#endif
1015
1016	INTEGER, SAVE :: ncount = 0
1017	!!
1018	!!--------------------------------------------------------------------
1019	!!
1020	ncount = ncount + 1
1021
1022	#ifdef key_mpp_mpi
1023
1024	request = 0
1025
1026	IF ( rootexchg ) THEN
1027	!
1028	! receive data from OASIS4 on local root
1029	!
1030	IF ( commRank ) &
1031	CALL prism_get (var_id, dater, dater_bound, global_array, info, ierror)
1032	CALL MPI_BCAST ( info, 1, MPI_INTEGER, localRoot, localComm, ierror )
1033
1034	ELSE
1035	!
1036	! receive local data from OASIS4 on every process
1037	!
1038	CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
1039
1040	ENDIF
1041
1042	action = (info==PRISM_CplIO)
1043
1044	IF ( rootexchg .and. action ) THEN
1045	!
1046	!mpi IF ( wp == 4 ) type = MPI_REAL
1047	!mpi IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
1048	!
1049	! distribute data to processes
1050	!
1051	IF ( localRank == localRoot ) THEN
1052
1053	DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
1054	DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
1055	exfld(ji,jj) = global_array(ji,jj)
1056	ENDDO
1057	ENDDO
1058
1059	DO jn = 1, localSize-1
1060
1061	DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
1062	DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
1063	buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 ) = global_array(ji,jj)
1064	ENDDO
1065	ENDDO
1066
1067	!mpi CALL mpi_send(buffer, ranges(5,jn), type, jn, jn, localComm, ierror)
1068	CALL mppsend (jn, buffer, ranges(5,jn), jn, request)
1069
1070	ENDDO
1071
1072	ENDIF
1073
1074	IF ( localRank /= localRoot ) &
1075	!mpi CALL mpi_recv(exfld, range(5), type, localRoot, localRank, localComm, status, ierror)
1076	CALL mpprecv(localRank, exfld, range(5))
1077	ENDIF
1078
1079	IF ( action ) THEN
1080
1081	data_array = 0.0
1082
1083	DO jj = nldj, nlej
1084	DO ji = nldi, nlei
1085	data_array(ji,jj)=exfld(ji-nldi+1,jj-nldj+1)
1086	ENDDO
1087	ENDDO
1088
1089	IF (l_ctl) THEN
1090	WRITE(numout,) '***************'
1091	DO ji = 1, nrecv
1092	IF (var_id == recv_id(ji) ) THEN
1093	WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
1094	EXIT
1095	ENDIF
1096	ENDDO
1097	WRITE(numout,*) 'prism_get: var_id ', var_id
1098	WRITE(numout,*) 'prism_get: date ', date
1099	WRITE(numout,*) 'prism_get: info ', info
1100	WRITE(numout,*) ' - Minimum value is ', MINVAL(data_array)
1101	WRITE(numout,*) ' - Maximum value is ', MAXVAL(data_array)
1102	WRITE(numout,*) ' - Sum value is ', SUM(data_array)
1103	WRITE(numout,) '***************'
1104	ENDIF
1105
1106	ENDIF
1107	#else
1108
1109	CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
1110
1111	IF ( info==PRISM_CplIO ) THEN
1112	data_array=exfld
1113
1114	IF (l_ctl) THEN
1115	WRITE(numout,) '***************'
1116	DO ji = 1, nrecv
1117	IF (var_id == recv_id(ji) ) THEN
1118	WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
1119	EXIT
1120	ENDIF
1121	ENDDO
1122	WRITE(numout,*) 'prism_get: var_id ', var_id
1123	WRITE(numout,*) 'prism_get: date ', date
1124	WRITE(numout,*) 'prism_get: info ', info
1125	WRITE(numout,*) ' - Minimum value is ', MINVAL(data_array)
1126	WRITE(numout,*) ' - Maximum value is ', MAXVAL(data_array)
1127	WRITE(numout,*) ' - Sum value is ', SUM(data_array)
1128	WRITE(numout,) '***************'
1129	ENDIF
1130
1131	ENDIF
1132
1133	#endif
1134
1135	IF ( ncount == nrecv ) THEN
1136	!
1137	! 3. Update dater and dater_bound for next step. We assume that cpl_prism_recv
1138	! is called for all recv fields at each time step. Therefore we update
1139	! the date argument to prism_get only every nrecv call to cpl_prism_recv.
1140	!
1141	dater_bound(1) = dater_bound(2)
1142
1143	tmpdate = dater_bound(2)
1144	date_incr = rdttra(1)/2.0
1145
1146	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
1147	dater = tmpdate
1148	CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
1149	dater_bound(2) = tmpdate
1150
1151	ncount = 0
1152
1153	ENDIF
1154
1155	END SUBROUTINE cpl_prism_recv
1156
1157
1158
1159	SUBROUTINE cpl_prism_finalize
1160
1161	IMPLICIT NONE
1162
1163	!!---------------------------------------------------------------------
1164	!! * ROUTINE cpl_prism_finalize *
1165	!!
1166	!! ** Purpose : - Finalizes the coupling. If MPI_init has not been
1167	!! called explicitly before cpl_prism_init it will also close
1168	!! MPI communication.
1169	!!
1170	!! ** Method : OASIS4
1171	!!----------------------------------------------------------------------
1172
1173	DEALLOCATE(exfld)
1174
1175	if ( prism_was_initialized ) then
1176
1177	call prism_terminated ( prism_was_terminated, ierror )
1178
1179	if ( prism_was_terminated ) then
1180	print *, 'prism has already been terminated.'
1181	else
1182	call prism_terminate ( ierror )
1183	prism_was_terminated = .true.
1184	endif
1185
1186	else
1187
1188	print *, 'Initialize prism before terminating it.'
1189
1190	endif
1191
1192
1193	END SUBROUTINE cpl_prism_finalize
1194
1195	#else
1196
1197	!!----------------------------------------------------------------------
1198	!! Default case Dummy module forced Ocean/Atmosphere
1199	!!----------------------------------------------------------------------
1200	CONTAINS
1201	SUBROUTINE cpl_prism_init ! Dummy routine
1202	END SUBROUTINE cpl_prism_init
1203	SUBROUTINE cpl_prism_define ! Dummy routine
1204	END SUBROUTINE cpl_prism_define
1205	SUBROUTINE cpl_prism_send ! Dummy routine
1206	END SUBROUTINE cpl_prism_send
1207	SUBROUTINE cpl_prism_recv ! Dummy routine
1208	END SUBROUTINE cpl_prism_recv
1209	SUBROUTINE cpl_prism_finalize ! Dummy routine
1210	END SUBROUTINE cpl_prism_finalize
1211
1212	#endif
1213
1214	END MODULE cpl_oasis4

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

Download in other formats: