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