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/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90 @ 2329

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

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

Download in other formats: