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_oasis3.F90 in branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 9218

Last change on this file since 9218 was 9218, checked in by frrh, 6 years ago
First working version defining and receiveing 0D couping fields on PE 0 and broadcasting values using MPI_BCAST.
File size: 31.2 KB

Line
1	MODULE cpl_oasis3
2	!!======================================================================
3	!! * MODULE cpl_oasis *
4	!! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
5	!!=====================================================================
6	!! History :
7	!! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code
8	!! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
9	!! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing
10	!! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision
11	!! " " ! 05-09 (R. Redler) extended to allow for communication over root only
12	!! " " ! 06-01 (W. Park) modification of physical part
13	!! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange
14	!! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields
15	!!----------------------------------------------------------------------
16	!!----------------------------------------------------------------------
17	!! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT
18	!! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3
19	!!----------------------------------------------------------------------
20	!! cpl_init : initialization of coupled mode communication
21	!! cpl_define : definition of grid and fields
22	!! cpl_snd : snd out fields in coupled mode
23	!! cpl_rcv : receive fields in coupled mode
24	!! cpl_finalize : finalize the coupled mode communication
25	!!----------------------------------------------------------------------
26	#if defined key_oasis3
27	USE mod_oasis ! OASIS3-MCT module
28	#endif
29	USE par_oce ! ocean parameters
30	USE dom_oce ! ocean space and time domain
31	USE in_out_manager ! I/O manager
32	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
33
34	IMPLICIT NONE
35	PRIVATE
36
37	PUBLIC cpl_init
38	PUBLIC cpl_define
39	PUBLIC cpl_snd
40	PUBLIC cpl_rcv
41	PUBLIC cpl_rcv_1d
42	PUBLIC cpl_freq
43	PUBLIC cpl_finalize
44	#if defined key_mpp_mpi
45	INCLUDE 'mpif.h'
46	#endif
47
48	INTEGER, PARAMETER :: localRoot = 0
49	LOGICAL :: commRank ! true for ranks doing OASIS communication
50	#if defined key_cpl_rootexchg
51	LOGICAL :: rootexchg =.true. ! logical switch
52	#else
53	LOGICAL :: rootexchg =.false. ! logical switch
54	#endif
55
56	INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field
57	INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis
58	INTEGER :: ncomp_id ! id returned by oasis_init_comp
59	INTEGER :: nerror ! return error code
60	#if ! defined key_oasis3
61	! OASIS Variables not used. defined only for compilation purpose
62	INTEGER :: OASIS_Out = -1
63	INTEGER :: OASIS_REAL = -1
64	INTEGER :: OASIS_Ok = -1
65	INTEGER :: OASIS_In = -1
66	INTEGER :: OASIS_Sent = -1
67	INTEGER :: OASIS_SentOut = -1
68	INTEGER :: OASIS_ToRest = -1
69	INTEGER :: OASIS_ToRestOut = -1
70	INTEGER :: OASIS_Recvd = -1
71	INTEGER :: OASIS_RecvOut = -1
72	INTEGER :: OASIS_FromRest = -1
73	INTEGER :: OASIS_FromRestOut = -1
74	#endif
75
76	INTEGER :: nrcv ! total number of fields received
77	INTEGER :: nsnd ! total number of fields sent
78	INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
79	INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields
80	INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
81	INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
82
83	TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information
84	LOGICAL :: laction ! To be coupled or not
85	CHARACTER(len = 8) :: clname ! Name of the coupling field
86	CHARACTER(len = 1) :: clgrid ! Grid type
87	REAL(wp) :: nsgn ! Control of the sign change
88	INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models)
89	INTEGER :: nct ! Number of categories in field
90	INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received
91	INTEGER :: dimensions ! Number of dimensions of coupling field
92	END TYPE FLD_CPL
93
94	TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields
95
96	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
97	INTEGER, PUBLIC :: localComm
98
99	!!----------------------------------------------------------------------
100	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
101	!! $Id$
102	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
103	!!----------------------------------------------------------------------
104	CONTAINS
105
106	SUBROUTINE cpl_init( cd_modname, kl_comm )
107	!!-------------------------------------------------------------------
108	!! * ROUTINE cpl_init *
109	!!
110	!! ** Purpose : Initialize coupled mode communication for ocean
111	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
112	!!
113	!! ** Method : OASIS3 MPI communication
114	!!--------------------------------------------------------------------
115	CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file
116	INTEGER , INTENT(out) :: kl_comm ! local communicator of the model
117	!!--------------------------------------------------------------------
118
119	! WARNING: No write in numout in this routine
120	!============================================
121
122	!------------------------------------------------------------------
123	! 1st Initialize the OASIS system for the application
124	!------------------------------------------------------------------
125	CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
126	IF ( nerror /= OASIS_Ok ) &
127	CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
128
129	!------------------------------------------------------------------
130	! 3rd Get an MPI communicator for OPA local communication
131	!------------------------------------------------------------------
132
133	CALL oasis_get_localcomm ( kl_comm, nerror )
134	IF ( nerror /= OASIS_Ok ) &
135	CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
136	localComm = kl_comm
137	!
138	END SUBROUTINE cpl_init
139
140
141	SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
142	!!-------------------------------------------------------------------
143	!! * ROUTINE cpl_define *
144	!!
145	!! ** Purpose : Define grid and field information for ocean
146	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
147	!!
148	!! ** Method : OASIS3 MPI communication
149	!!--------------------------------------------------------------------
150	INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields
151	INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
152	!
153	INTEGER :: id_part
154	INTEGER :: id_part_0d ! Partition for 0d fields
155	INTEGER :: paral(5) ! OASIS3 box partition
156	INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe
157	INTEGER :: ji,jc,jm ! local loop indicees
158	CHARACTER(LEN=64) :: zclname
159	CHARACTER(LEN=2) :: cli2
160	!!--------------------------------------------------------------------
161
162	IF(lwp) WRITE(numout,*)
163	IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
164	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
165	IF(lwp) WRITE(numout,*)
166
167	ncplmodel = kcplmodel
168	IF( kcplmodel > nmaxcpl ) THEN
169	CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
170	ENDIF
171
172	nrcv = krcv
173	IF( nrcv > nmaxfld ) THEN
174	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
175	ENDIF
176
177	nsnd = ksnd
178	IF( nsnd > nmaxfld ) THEN
179	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
180	ENDIF
181
182	!
183	! ... Define the shape for the area that excludes the halo
184	! For serial configuration (key_mpp_mpi not being active)
185	! nl* is set to the global values 1 and jp*glo.
186	!
187	ishape(:,1) = (/ 1, nlei-nldi+1 /)
188	ishape(:,2) = (/ 1, nlej-nldj+1 /)
189	!
190	! ... Allocate memory for data exchange
191	!
192	ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
193	IF( nerror > 0 ) THEN
194	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN
195	ENDIF
196	!
197	! -----------------------------------------------------------------
198	! ... Define the partition
199	! -----------------------------------------------------------------
200
201	paral(1) = 2 ! box partitioning
202	paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset
203	paral(3) = nlei-nldi+1 ! local extent in i
204	paral(4) = nlej-nldj+1 ! local extent in j
205	paral(5) = jpiglo ! global extent in x
206
207	IF( ln_ctl ) THEN
208	WRITE(numout,*) ' multiexchg: paral (1:5)', paral
209	WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
210	WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
211	WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
212	ENDIF
213
214	CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo)
215
216	! A special partition is needed for 0D fields
217
218	paral(1) = 0 ! serial partitioning
219	paral(2) = 0
220	IF ( nproc == 0) THEN
221	paral(3) = 1 ! Size of array to couple (scalar)
222	ELSE
223	paral(3) = 0 ! Dummy size for PE's not involved
224	END IF
225	paral(4) = 0
226	paral(5) = 0
227
228	CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 )
229
230
231
232	!
233	! ... Announce send variables.
234	!
235	ssnd(:)%ncplmodel = kcplmodel
236	!
237	DO ji = 1, ksnd
238	IF ( ssnd(ji)%laction ) THEN
239
240	IF( ssnd(ji)%nct > nmaxcat ) THEN
241	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
242	& TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
243	RETURN
244	ENDIF
245
246	DO jc = 1, ssnd(ji)%nct
247	DO jm = 1, kcplmodel
248
249	IF ( ssnd(ji)%nct .GT. 1 ) THEN
250	WRITE(cli2,'(i2.2)') jc
251	zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
252	ELSE
253	zclname = ssnd(ji)%clname
254	ENDIF
255	IF ( kcplmodel > 1 ) THEN
256	WRITE(cli2,'(i2.2)') jm
257	zclname = 'model'//cli2//'_'//TRIM(zclname)
258	ENDIF
259	#if defined key_agrif
260	IF( agrif_fixed() /= 0 ) THEN
261	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
262	END IF
263	#endif
264	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
265	CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
266	& OASIS_Out , ishape , OASIS_REAL, nerror )
267	IF ( nerror /= OASIS_Ok ) THEN
268	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
269	CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
270	ENDIF
271	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
272	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
273	END DO
274	END DO
275	ENDIF
276	END DO
277	!
278	! ... Announce received variables.
279	!
280	srcv(:)%ncplmodel = kcplmodel
281	!
282	DO ji = 1, krcv
283	IF ( srcv(ji)%laction ) THEN
284
285	IF( srcv(ji)%nct > nmaxcat ) THEN
286	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
287	& TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
288	RETURN
289	ENDIF
290
291	DO jc = 1, srcv(ji)%nct
292	DO jm = 1, kcplmodel
293
294	IF ( srcv(ji)%nct .GT. 1 ) THEN
295	WRITE(cli2,'(i2.2)') jc
296	zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
297	ELSE
298	zclname = srcv(ji)%clname
299	ENDIF
300	IF ( kcplmodel > 1 ) THEN
301	WRITE(cli2,'(i2.2)') jm
302	zclname = 'model'//cli2//'_'//TRIM(zclname)
303	ENDIF
304	#if defined key_agrif
305	IF( agrif_fixed() /= 0 ) THEN
306	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
307	END IF
308	#endif
309	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
310	flush(numout)
311
312	! If it's Greenland or Antarctic ice mass then define a 0D field
313	IF (srcv(ji)%dimensions == 0) THEN
314	WRITE(numout,*) "RSRH 0d define field ",zclname; flush(numout)
315	! Define 0D coupling fields
316	IF (nproc == 0) THEN
317	CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , (/ 1, 0 /), &
318	OASIS_In , (/ 1, 1 /) , OASIS_REAL, nerror )
319	ELSE
320	! Dummy call to keep OASIS3-MCT happy.
321	CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , (/ 1, 0 /), &
322	OASIS_In , (/ 0, 0 /) , OASIS_REAL, nerror )
323	END IF
324	WRITE(numout,*) "RSRH 0d field done ",zclname,nerror; flush(numout)
325	ELSE
326	WRITE(numout,*) "RSRH 2d define field ",zclname; flush(numout)
327	! It's a "normal" 2D (or pseudo 3D) coupling field.
328	CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
329	OASIS_In , ishape , OASIS_REAL, nerror )
330	WRITE(numout,*) "RSRH 2d field done ",zclname,nerror; flush(numout)
331	ENDIF
332
333	IF ( nerror /= OASIS_Ok ) THEN
334	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
335	CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
336	ENDIF
337	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
338	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
339
340	END DO
341	END DO
342	ENDIF
343	END DO
344
345	!------------------------------------------------------------------
346	! End of definition phase
347	!------------------------------------------------------------------
348	WRITE(numout,*) "RSRH NEMO calling enddef";flush(numout)
349	CALL oasis_enddef(nerror)
350	WRITE(numout,*) "RSRH NEMO finished enddef", nerror;flush(numout)
351	IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
352	!
353	END SUBROUTINE cpl_define
354
355
356	SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
357	!!---------------------------------------------------------------------
358	!! * ROUTINE cpl_snd *
359	!!
360	!! ** Purpose : - At each coupling time-step,this routine sends fields
361	!! like sst or ice cover to the coupler or remote application.
362	!!----------------------------------------------------------------------
363	INTEGER , INTENT(in ) :: kid ! variable index in the array
364	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
365	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
366	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata
367	!!
368	INTEGER :: jc,jm ! local loop index
369	!!--------------------------------------------------------------------
370	!
371	! snd data to OASIS3
372	!
373	DO jc = 1, ssnd(kid)%nct
374	DO jm = 1, ssnd(kid)%ncplmodel
375
376	IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
377	CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
378
379	IF ( ln_ctl ) THEN
380	IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. &
381	& kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN
382	WRITE(numout,) '***************'
383	WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
384	WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
385	WRITE(numout,*) 'oasis_put: kstep ', kstep
386	WRITE(numout,*) 'oasis_put: info ', kinfo
387	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
388	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
389	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
390	WRITE(numout,) '***************'
391	ENDIF
392	ENDIF
393
394	ENDIF
395
396	ENDDO
397	ENDDO
398	!
399	END SUBROUTINE cpl_snd
400
401
402	SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
403	!!---------------------------------------------------------------------
404	!! * ROUTINE cpl_rcv *
405	!!
406	!! ** Purpose : - At each coupling time-step,this routine receives fields
407	!! like stresses and fluxes from the coupler or remote application.
408	!!----------------------------------------------------------------------
409	INTEGER , INTENT(in ) :: kid ! variable index in the array
410	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
411	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done
412	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask
413	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
414	!!
415	INTEGER :: jc,jm ! local loop index
416	LOGICAL :: llaction, llfisrt
417	!!--------------------------------------------------------------------
418	!
419	! receive local data from OASIS3 on every process
420	!
421	kinfo = OASIS_idle
422	!
423	DO jc = 1, srcv(kid)%nct
424	llfisrt = .TRUE.
425
426	DO jm = 1, srcv(kid)%ncplmodel
427
428	IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
429
430
431	IF (( srcv(kid)%dimensions /= 0) .OR. &
432	(( srcv(kid)%dimensions == 0) .AND. nproc == 0)) THEN
433	! Zero dimension fields must only be exchanged through the master PE.
434	! In normal 2D cases, every PE is involved.
435
436	CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )
437
438	llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &
439	& kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
440
441	IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
442
443	IF ( llaction ) THEN
444
445	kinfo = OASIS_Rcv
446	IF( llfisrt ) THEN
447	pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
448	llfisrt = .FALSE.
449	ELSE
450	pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
451	ENDIF
452
453	IF ( ln_ctl ) THEN
454	WRITE(numout,) '***************'
455	WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
456	WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm)
457	WRITE(numout,*) 'oasis_get: kstep', kstep
458	WRITE(numout,*) 'oasis_get: info ', kinfo
459	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
460	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
461	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
462	WRITE(numout,) '***************'
463	ENDIF
464
465	ENDIF
466	ENDIF
467	ENDIF
468
469	ENDDO
470
471	!--- Fill the overlap areas and extra hallows (mpp)
472	!--- check periodicity conditions (all cases)
473	IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
474
475	ENDDO
476	!
477	END SUBROUTINE cpl_rcv
478
479	SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, items, kinfo )
480	!!---------------------------------------------------------------------
481	!! * ROUTINE cpl_rcv_1d *
482	!!
483	!! ** Purpose : - A special version of cpl_rcv to deal exclusively with
484	!! 1D fields. The one dimension in this sense does not represent any spatial
485	!! dimension, it merely represents an arbitrary number of single values
486	!! i.e. the fields recieved are simply an array (which may be of size 1)
487	!! of 0 dimensional fields.
488	!!----------------------------------------------------------------------
489	INTEGER , INTENT(in ) :: items ! variable index in the array
490	INTEGER , INTENT(in ) :: kid ! variable index in the array
491	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
492	REAL(wp), INTENT(inout) :: pdata(1:items) ! IN to keep the value if nothing is done
493	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
494	!!
495	REAL(wp) :: recvfld(1:items) ! Received field
496	INTEGER :: jc,jm ! local loop index
497	INTEGER :: ierr
498	LOGICAL :: llaction, llfisrt
499	!!--------------------------------------------------------------------
500	!
501	! receive local data from OASIS3 on every process
502	!
503	kinfo = OASIS_idle
504	!
505	jc = 1
506
507	DO jm = 1, srcv(kid)%ncplmodel
508
509	IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
510
511
512	IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN
513	! Zero dimension fields must only be exchanged through the master PE.
514	! In normal 2D cases, every PE is involved.
515
516	CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )
517
518	llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &
519	& kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
520
521	IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
522
523	IF ( llaction ) THEN
524
525	kinfo = OASIS_Rcv
526	pdata(1:items) = recvfld(1:items)
527
528	IF ( ln_ctl ) THEN
529	WRITE(numout,) '***************'
530	WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
531	WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm)
532	WRITE(numout,*) 'oasis_get: kstep', kstep
533	WRITE(numout,*) 'oasis_get: info ', kinfo
534	WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:))
535	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:))
536	WRITE(numout,) '***************'
537	ENDIF
538
539	ENDIF
540	ENDIF
541	ENDIF
542
543	ENDDO
544	write(numout,*) "RSRH call bcast for 0D size",items;flush(numout)
545
546	! There are no halos to deal with but we do have to broadcast values from PE 0 to all the
547	! others.
548	CALL mpi_bcast( pdata, items, MPI_Real, localRoot, mpi_comm_opa, ierr )
549	write(numout,*) "RSRH done bcast for 0D";flush(numout)
550
551	!
552	END SUBROUTINE cpl_rcv_1d
553
554
555	INTEGER FUNCTION cpl_freq( cdfieldname )
556	!!---------------------------------------------------------------------
557	!! * ROUTINE cpl_freq *
558	!!
559	!! ** Purpose : - send back the coupling frequency for a particular field
560	!!----------------------------------------------------------------------
561	CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file
562	!!
563	INTEGER :: id
564	INTEGER :: info
565	INTEGER, DIMENSION(1) :: itmp
566	INTEGER :: ji,jm ! local loop index
567	INTEGER :: mop
568	!!----------------------------------------------------------------------
569	cpl_freq = 0 ! defaut definition
570	id = -1 ! defaut definition
571	!
572	DO ji = 1, nsnd
573	IF (ssnd(ji)%laction ) THEN
574	DO jm = 1, ncplmodel
575	IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
576	IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
577	id = ssnd(ji)%nid(1,jm)
578	mop = OASIS_Out
579	ENDIF
580	ENDIF
581	ENDDO
582	ENDIF
583	ENDDO
584	DO ji = 1, nrcv
585	IF (srcv(ji)%laction ) THEN
586	DO jm = 1, ncplmodel
587	IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
588	IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
589	id = srcv(ji)%nid(1,jm)
590	mop = OASIS_In
591	ENDIF
592	ENDIF
593	ENDDO
594	ENDIF
595	ENDDO
596	!
597	IF( id /= -1 ) THEN
598	#if defined key_oa3mct_v3
599	CALL oasis_get_freqs(id, mop, 1, itmp, info)
600	#else
601	#if defined key_oasis3
602	itmp(1) = namflddti( id )
603	#else
604	CALL oasis_get_freqs(id, 1, itmp, info)
605	#endif
606	#endif
607	cpl_freq = itmp(1)
608	ENDIF
609	!
610	END FUNCTION cpl_freq
611
612
613	SUBROUTINE cpl_finalize
614	!!---------------------------------------------------------------------
615	!! * ROUTINE cpl_finalize *
616	!!
617	!! ** Purpose : - Finalizes the coupling. If MPI_init has not been
618	!! called explicitly before cpl_init it will also close
619	!! MPI communication.
620	!!----------------------------------------------------------------------
621	!
622	DEALLOCATE( exfld )
623	IF (nstop == 0) THEN
624	CALL oasis_terminate( nerror )
625	ELSE
626	CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
627	ENDIF
628	!
629	END SUBROUTINE cpl_finalize
630
631	#if ! defined key_oasis3
632
633	!!----------------------------------------------------------------------
634	!! No OASIS Library OASIS3 Dummy module...
635	!!----------------------------------------------------------------------
636
637	SUBROUTINE oasis_init_comp(k1,cd1,k2)
638	CHARACTER(*), INTENT(in ) :: cd1
639	INTEGER , INTENT( out) :: k1,k2
640	k1 = -1 ; k2 = -1
641	WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
642	END SUBROUTINE oasis_init_comp
643
644	SUBROUTINE oasis_abort(k1,cd1,cd2)
645	INTEGER , INTENT(in ) :: k1
646	CHARACTER(*), INTENT(in ) :: cd1,cd2
647	WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
648	END SUBROUTINE oasis_abort
649
650	SUBROUTINE oasis_get_localcomm(k1,k2)
651	INTEGER , INTENT( out) :: k1,k2
652	k1 = -1 ; k2 = -1
653	WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
654	END SUBROUTINE oasis_get_localcomm
655
656	SUBROUTINE oasis_def_partition(k1,k2,k3,K4)
657	INTEGER , INTENT( out) :: k1,k3
658	INTEGER , INTENT(in ) :: k2(5)
659	INTEGER , OPTIONAL, INTENT(in ) :: k4
660	k1 = k2(1) ; k3 = k2(5)
661	WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
662	END SUBROUTINE oasis_def_partition
663
664	SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
665	CHARACTER(*), INTENT(in ) :: cd1
666	INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6
667	INTEGER , INTENT( out) :: k1,k7
668	k1 = -1 ; k7 = -1
669	WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
670	END SUBROUTINE oasis_def_var
671
672	SUBROUTINE oasis_enddef(k1)
673	INTEGER , INTENT( out) :: k1
674	k1 = -1
675	WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
676	END SUBROUTINE oasis_enddef
677
678	SUBROUTINE oasis_put(k1,k2,p1,k3)
679	REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1
680	INTEGER , INTENT(in ) :: k1,k2
681	INTEGER , INTENT( out) :: k3
682	k3 = -1
683	WRITE(numout,*) 'oasis_put: Error you sould not be there...'
684	END SUBROUTINE oasis_put
685
686	SUBROUTINE oasis_get(k1,k2,p1,k3)
687	REAL(wp), DIMENSION(:,:), INTENT( out) :: p1
688	INTEGER , INTENT(in ) :: k1,k2
689	INTEGER , INTENT( out) :: k3
690	p1(1,1) = -1. ; k3 = -1
691	WRITE(numout,*) 'oasis_get: Error you sould not be there...'
692	END SUBROUTINE oasis_get
693
694	SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
695	INTEGER , INTENT(in ) :: k1,k2
696	INTEGER, DIMENSION(1), INTENT( out) :: k3
697	INTEGER , INTENT( out) :: k4
698	k3(1) = k1 ; k4 = k2
699	WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
700	END SUBROUTINE oasis_get_freqs
701
702	SUBROUTINE oasis_terminate(k1)
703	INTEGER , INTENT( out) :: k1
704	k1 = -1
705	WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
706	END SUBROUTINE oasis_terminate
707
708	#endif
709
710	!!=====================================================================
711	END MODULE cpl_oasis3

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

Download in other formats: