Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

cpl_oasis3.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago
The Dr Hook changes from my perl code.
File size: 31.3 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	USE yomhook, ONLY: lhook, dr_hook
35	USE parkind1, ONLY: jprb, jpim
36
37	IMPLICIT NONE
38	PRIVATE
39
40	PUBLIC cpl_init
41	PUBLIC cpl_define
42	PUBLIC cpl_snd
43	PUBLIC cpl_rcv
44	PUBLIC cpl_freq
45	PUBLIC cpl_finalize
46	#if defined key_mpp_mpi
47	INCLUDE 'mpif.h'
48	#endif
49
50	INTEGER, PARAMETER :: localRoot = 0
51	LOGICAL :: commRank ! true for ranks doing OASIS communication
52	#if defined key_cpl_rootexchg
53	LOGICAL :: rootexchg =.true. ! logical switch
54	#else
55	LOGICAL :: rootexchg =.false. ! logical switch
56	#endif
57
58	INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field
59	INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis
60	INTEGER :: ncomp_id ! id returned by oasis_init_comp
61	INTEGER :: nerror ! return error code
62	#if ! defined key_oasis3
63	! OASIS Variables not used. defined only for compilation purpose
64	INTEGER :: OASIS_Out = -1
65	INTEGER :: OASIS_REAL = -1
66	INTEGER :: OASIS_Ok = -1
67	INTEGER :: OASIS_In = -1
68	INTEGER :: OASIS_Sent = -1
69	INTEGER :: OASIS_SentOut = -1
70	INTEGER :: OASIS_ToRest = -1
71	INTEGER :: OASIS_ToRestOut = -1
72	INTEGER :: OASIS_Recvd = -1
73	INTEGER :: OASIS_RecvOut = -1
74	INTEGER :: OASIS_FromRest = -1
75	INTEGER :: OASIS_FromRestOut = -1
76	#endif
77
78	INTEGER :: nrcv ! total number of fields received
79	INTEGER :: nsnd ! total number of fields sent
80	INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
81	INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields
82	INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
83	INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
84
85	TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information
86	LOGICAL :: laction ! To be coupled or not
87	CHARACTER(len = 8) :: clname ! Name of the coupling field
88	CHARACTER(len = 1) :: clgrid ! Grid type
89	REAL(wp) :: nsgn ! Control of the sign change
90	INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models)
91	INTEGER :: nct ! Number of categories in field
92	INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received
93	END TYPE FLD_CPL
94
95	TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields
96
97	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
98	INTEGER, PUBLIC :: localComm
99
100	!!----------------------------------------------------------------------
101	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
102	!! $Id$
103	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
104	!!----------------------------------------------------------------------
105	CONTAINS
106
107	SUBROUTINE cpl_init( cd_modname, kl_comm )
108	!!-------------------------------------------------------------------
109	!! * ROUTINE cpl_init *
110	!!
111	!! ** Purpose : Initialize coupled mode communication for ocean
112	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
113	!!
114	!! ** Method : OASIS3 MPI communication
115	!!--------------------------------------------------------------------
116	CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file
117	INTEGER , INTENT(out) :: kl_comm ! local communicator of the model
118	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
119	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
120	REAL(KIND=jprb) :: zhook_handle
121
122	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_INIT'
123
124	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
125
126	!!--------------------------------------------------------------------
127
128	! WARNING: No write in numout in this routine
129	!============================================
130
131	!------------------------------------------------------------------
132	! 1st Initialize the OASIS system for the application
133	!------------------------------------------------------------------
134	CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
135	IF ( nerror /= OASIS_Ok ) &
136	CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
137
138	!------------------------------------------------------------------
139	! 3rd Get an MPI communicator for OPA local communication
140	!------------------------------------------------------------------
141
142	CALL oasis_get_localcomm ( kl_comm, nerror )
143	IF ( nerror /= OASIS_Ok ) &
144	CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
145	localComm = kl_comm
146	!
147	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
148	END SUBROUTINE cpl_init
149
150
151	SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
152	!!-------------------------------------------------------------------
153	!! * ROUTINE cpl_define *
154	!!
155	!! ** Purpose : Define grid and field information for ocean
156	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
157	!!
158	!! ** Method : OASIS3 MPI communication
159	!!--------------------------------------------------------------------
160	INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields
161	INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
162	!
163	INTEGER :: id_part
164	INTEGER :: paral(5) ! OASIS3 box partition
165	INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe
166	INTEGER :: ji,jc,jm ! local loop indicees
167	CHARACTER(LEN=64) :: zclname
168	CHARACTER(LEN=2) :: cli2
169	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
170	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
171	REAL(KIND=jprb) :: zhook_handle
172
173	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_DEFINE'
174
175	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
176
177	!!--------------------------------------------------------------------
178
179	IF(lwp) WRITE(numout,*)
180	IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
181	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
182	IF(lwp) WRITE(numout,*)
183
184	ncplmodel = kcplmodel
185	IF( kcplmodel > nmaxcpl ) THEN
186	CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
187	ENDIF
188
189	nrcv = krcv
190	IF( nrcv > nmaxfld ) THEN
191	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
192	ENDIF
193
194	nsnd = ksnd
195	IF( nsnd > nmaxfld ) THEN
196	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
197	ENDIF
198
199	!
200	! ... Define the shape for the area that excludes the halo
201	! For serial configuration (key_mpp_mpi not being active)
202	! nl* is set to the global values 1 and jp*glo.
203	!
204	ishape(:,1) = (/ 1, nlei-nldi+1 /)
205	ishape(:,2) = (/ 1, nlej-nldj+1 /)
206	!
207	! ... Allocate memory for data exchange
208	!
209	ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
210	IF( nerror > 0 ) THEN
211	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN
212	ENDIF
213	!
214	! -----------------------------------------------------------------
215	! ... Define the partition
216	! -----------------------------------------------------------------
217
218	paral(1) = 2 ! box partitioning
219	paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset
220	paral(3) = nlei-nldi+1 ! local extent in i
221	paral(4) = nlej-nldj+1 ! local extent in j
222	paral(5) = jpiglo ! global extent in x
223
224	IF( ln_ctl ) THEN
225	WRITE(numout,*) ' multiexchg: paral (1:5)', paral
226	WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
227	WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
228	WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
229	ENDIF
230
231	CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo)
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	IF (lhook) CALL dr_hook(RoutineName,zhook_out ,zhook_handle)
244	RETURN
245	ENDIF
246
247	DO jc = 1, ssnd(ji)%nct
248	DO jm = 1, kcplmodel
249
250	IF ( ssnd(ji)%nct .GT. 1 ) THEN
251	WRITE(cli2,'(i2.2)') jc
252	zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
253	ELSE
254	zclname = ssnd(ji)%clname
255	ENDIF
256	IF ( kcplmodel > 1 ) THEN
257	WRITE(cli2,'(i2.2)') jm
258	zclname = 'model'//cli2//'_'//TRIM(zclname)
259	ENDIF
260	#if defined key_agrif
261	IF( agrif_fixed() /= 0 ) THEN
262	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
263	END IF
264	#endif
265	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
266	CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
267	& OASIS_Out , ishape , OASIS_REAL, nerror )
268	IF ( nerror /= OASIS_Ok ) THEN
269	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
270	CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
271	ENDIF
272	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
273	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
274	END DO
275	END DO
276	ENDIF
277	END DO
278	!
279	! ... Announce received variables.
280	!
281	srcv(:)%ncplmodel = kcplmodel
282	!
283	DO ji = 1, krcv
284	IF ( srcv(ji)%laction ) THEN
285
286	IF( srcv(ji)%nct > nmaxcat ) THEN
287	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
288	& TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
289	IF (lhook) CALL dr_hook(RoutineName,zhook_out ,zhook_handle)
290	RETURN
291	ENDIF
292
293	DO jc = 1, srcv(ji)%nct
294	DO jm = 1, kcplmodel
295
296	IF ( srcv(ji)%nct .GT. 1 ) THEN
297	WRITE(cli2,'(i2.2)') jc
298	zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
299	ELSE
300	zclname = srcv(ji)%clname
301	ENDIF
302	IF ( kcplmodel > 1 ) THEN
303	WRITE(cli2,'(i2.2)') jm
304	zclname = 'model'//cli2//'_'//TRIM(zclname)
305	ENDIF
306	#if defined key_agrif
307	IF( agrif_fixed() /= 0 ) THEN
308	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
309	END IF
310	#endif
311	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
312	CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), &
313	& OASIS_In , ishape , OASIS_REAL, nerror )
314	IF ( nerror /= OASIS_Ok ) THEN
315	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
316	CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
317	ENDIF
318	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
319	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
320
321	END DO
322	END DO
323	ENDIF
324	END DO
325
326	!------------------------------------------------------------------
327	! End of definition phase
328	!------------------------------------------------------------------
329
330	CALL oasis_enddef(nerror)
331	IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
332	!
333	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
334	END SUBROUTINE cpl_define
335
336
337	SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
338	!!---------------------------------------------------------------------
339	!! * ROUTINE cpl_snd *
340	!!
341	!! ** Purpose : - At each coupling time-step,this routine sends fields
342	!! like sst or ice cover to the coupler or remote application.
343	!!----------------------------------------------------------------------
344	INTEGER , INTENT(in ) :: kid ! variable index in the array
345	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
346	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
347	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata
348	!!
349	INTEGER :: jc,jm ! local loop index
350	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
351	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
352	REAL(KIND=jprb) :: zhook_handle
353
354	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_SND'
355
356	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
357
358	!!--------------------------------------------------------------------
359	!
360	! snd data to OASIS3
361	!
362	DO jc = 1, ssnd(kid)%nct
363	DO jm = 1, ssnd(kid)%ncplmodel
364
365	IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
366	CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
367
368	IF ( ln_ctl ) THEN
369	IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. &
370	& kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN
371	WRITE(numout,) '***************'
372	WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
373	WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
374	WRITE(numout,*) 'oasis_put: kstep ', kstep
375	WRITE(numout,*) 'oasis_put: info ', kinfo
376	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
377	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
378	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
379	WRITE(numout,) '***************'
380	ENDIF
381	ENDIF
382
383	ENDIF
384
385	ENDDO
386	ENDDO
387	!
388	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
389	END SUBROUTINE cpl_snd
390
391
392	SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
393	!!---------------------------------------------------------------------
394	!! * ROUTINE cpl_rcv *
395	!!
396	!! ** Purpose : - At each coupling time-step,this routine receives fields
397	!! like stresses and fluxes from the coupler or remote application.
398	!!----------------------------------------------------------------------
399	INTEGER , INTENT(in ) :: kid ! variable index in the array
400	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
401	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done
402	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask
403	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
404	!!
405	INTEGER :: jc,jm ! local loop index
406	LOGICAL :: llaction, llfisrt
407	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
408	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
409	REAL(KIND=jprb) :: zhook_handle
410
411	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_RCV'
412
413	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
414
415	!!--------------------------------------------------------------------
416	!
417	! receive local data from OASIS3 on every process
418	!
419	kinfo = OASIS_idle
420	!
421	DO jc = 1, srcv(kid)%nct
422	llfisrt = .TRUE.
423
424	DO jm = 1, srcv(kid)%ncplmodel
425
426	IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
427
428	CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )
429
430	llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &
431	& kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
432
433	IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
434
435	IF ( llaction ) THEN
436
437	kinfo = OASIS_Rcv
438	IF( llfisrt ) THEN
439	pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
440	llfisrt = .FALSE.
441	ELSE
442	pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
443	ENDIF
444
445	IF ( ln_ctl ) THEN
446	WRITE(numout,) '***************'
447	WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
448	WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm)
449	WRITE(numout,*) 'oasis_get: kstep', kstep
450	WRITE(numout,*) 'oasis_get: info ', kinfo
451	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
452	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
453	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
454	WRITE(numout,) '***************'
455	ENDIF
456
457	ENDIF
458
459	ENDIF
460
461	ENDDO
462
463	!--- Fill the overlap areas and extra hallows (mpp)
464	!--- check periodicity conditions (all cases)
465	IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
466
467	ENDDO
468	!
469	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
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	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
487	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
488	REAL(KIND=jprb) :: zhook_handle
489
490	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_FREQ'
491
492	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
493
494	!!----------------------------------------------------------------------
495	cpl_freq = 0 ! defaut definition
496	id = -1 ! defaut definition
497	!
498	DO ji = 1, nsnd
499	IF (ssnd(ji)%laction ) THEN
500	DO jm = 1, ncplmodel
501	IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
502	IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
503	id = ssnd(ji)%nid(1,jm)
504	mop = OASIS_Out
505	ENDIF
506	ENDIF
507	ENDDO
508	ENDIF
509	ENDDO
510	DO ji = 1, nrcv
511	IF (srcv(ji)%laction ) THEN
512	DO jm = 1, ncplmodel
513	IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
514	IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
515	id = srcv(ji)%nid(1,jm)
516	mop = OASIS_In
517	ENDIF
518	ENDIF
519	ENDDO
520	ENDIF
521	ENDDO
522	!
523	IF( id /= -1 ) THEN
524	#if defined key_oa3mct_v3
525	CALL oasis_get_freqs(id, mop, 1, itmp, info)
526	#else
527	#if defined key_oasis3
528	itmp(1) = namflddti( id )
529	#else
530	CALL oasis_get_freqs(id, 1, itmp, info)
531	#endif
532	#endif
533	cpl_freq = itmp(1)
534	ENDIF
535	!
536	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
537	END FUNCTION cpl_freq
538
539
540	SUBROUTINE cpl_finalize
541	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
542	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
543	REAL(KIND=jprb) :: zhook_handle
544
545	CHARACTER(LEN=*), PARAMETER :: RoutineName='CPL_FINALIZE'
546
547	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
548
549	!!---------------------------------------------------------------------
550	!! * ROUTINE cpl_finalize *
551	!!
552	!! ** Purpose : - Finalizes the coupling. If MPI_init has not been
553	!! called explicitly before cpl_init it will also close
554	!! MPI communication.
555	!!----------------------------------------------------------------------
556	!
557	DEALLOCATE( exfld )
558	IF (nstop == 0) THEN
559	CALL oasis_terminate( nerror )
560	ELSE
561	CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
562	ENDIF
563	!
564	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
565	END SUBROUTINE cpl_finalize
566
567	#if ! defined key_oasis3
568
569	!!----------------------------------------------------------------------
570	!! No OASIS Library OASIS3 Dummy module...
571	!!----------------------------------------------------------------------
572
573	SUBROUTINE oasis_init_comp(k1,cd1,k2)
574	CHARACTER(*), INTENT(in ) :: cd1
575	INTEGER , INTENT( out) :: k1,k2
576	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
577	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
578	REAL(KIND=jprb) :: zhook_handle
579
580	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_INIT_COMP'
581
582	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
583
584	k1 = -1 ; k2 = -1
585	WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
586	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
587	END SUBROUTINE oasis_init_comp
588
589	SUBROUTINE oasis_abort(k1,cd1,cd2)
590	INTEGER , INTENT(in ) :: k1
591	CHARACTER(*), INTENT(in ) :: cd1,cd2
592	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
593	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
594	REAL(KIND=jprb) :: zhook_handle
595
596	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_ABORT'
597
598	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
599
600	WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
601	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
602	END SUBROUTINE oasis_abort
603
604	SUBROUTINE oasis_get_localcomm(k1,k2)
605	INTEGER , INTENT( out) :: k1,k2
606	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
607	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
608	REAL(KIND=jprb) :: zhook_handle
609
610	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_GET_LOCALCOMM'
611
612	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
613
614	k1 = -1 ; k2 = -1
615	WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
616	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
617	END SUBROUTINE oasis_get_localcomm
618
619	SUBROUTINE oasis_def_partition(k1,k2,k3,K4)
620	INTEGER , INTENT( out) :: k1,k3
621	INTEGER , INTENT(in ) :: k2(5)
622	INTEGER , OPTIONAL, INTENT(in ) :: k4
623	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
624	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
625	REAL(KIND=jprb) :: zhook_handle
626
627	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_DEF_PARTITION'
628
629	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
630
631	k1 = k2(1) ; k3 = k2(5)
632	WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
633	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
634	END SUBROUTINE oasis_def_partition
635
636	SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
637	CHARACTER(*), INTENT(in ) :: cd1
638	INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6
639	INTEGER , INTENT( out) :: k1,k7
640	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
641	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
642	REAL(KIND=jprb) :: zhook_handle
643
644	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_DEF_VAR'
645
646	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
647
648	k1 = -1 ; k7 = -1
649	WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
650	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
651	END SUBROUTINE oasis_def_var
652
653	SUBROUTINE oasis_enddef(k1)
654	INTEGER , INTENT( out) :: k1
655	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
656	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
657	REAL(KIND=jprb) :: zhook_handle
658
659	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_ENDDEF'
660
661	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
662
663	k1 = -1
664	WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
665	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
666	END SUBROUTINE oasis_enddef
667
668	SUBROUTINE oasis_put(k1,k2,p1,k3)
669	REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1
670	INTEGER , INTENT(in ) :: k1,k2
671	INTEGER , INTENT( out) :: k3
672	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
673	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
674	REAL(KIND=jprb) :: zhook_handle
675
676	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_PUT'
677
678	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
679
680	k3 = -1
681	WRITE(numout,*) 'oasis_put: Error you sould not be there...'
682	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
683	END SUBROUTINE oasis_put
684
685	SUBROUTINE oasis_get(k1,k2,p1,k3)
686	REAL(wp), DIMENSION(:,:), INTENT( out) :: p1
687	INTEGER , INTENT(in ) :: k1,k2
688	INTEGER , INTENT( out) :: k3
689	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
690	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
691	REAL(KIND=jprb) :: zhook_handle
692
693	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_GET'
694
695	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
696
697	p1(1,1) = -1. ; k3 = -1
698	WRITE(numout,*) 'oasis_get: Error you sould not be there...'
699	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
700	END SUBROUTINE oasis_get
701
702	SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
703	INTEGER , INTENT(in ) :: k1,k2
704	INTEGER, DIMENSION(1), INTENT( out) :: k3
705	INTEGER , INTENT( out) :: k4
706	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
707	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
708	REAL(KIND=jprb) :: zhook_handle
709
710	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_GET_FREQS'
711
712	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
713
714	k3(1) = k1 ; k4 = k2
715	WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
716	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
717	END SUBROUTINE oasis_get_freqs
718
719	SUBROUTINE oasis_terminate(k1)
720	INTEGER , INTENT( out) :: k1
721	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
722	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
723	REAL(KIND=jprb) :: zhook_handle
724
725	CHARACTER(LEN=*), PARAMETER :: RoutineName='OASIS_TERMINATE'
726
727	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
728
729	k1 = -1
730	WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
731	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
732	END SUBROUTINE oasis_terminate
733
734	#endif
735
736	!!=====================================================================
737	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: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 11738

Download in other formats: