Context Navigation

cpl_oasis3.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

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

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

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

Context Navigation

source: NEMO/trunk/src/OCE/SBC/cpl_oasis3.F90 @ 12377

Download in other formats: