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

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 25.2 KB
Line 
1MODULE 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=50   ! 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   
72   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information
73      LOGICAL               ::   laction   ! To be coupled or not
74      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field   
75      CHARACTER(len = 1)    ::   clgrid    ! Grid type 
76      REAL(wp)              ::   nsgn      ! Control of the sign change
77      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models)
78      INTEGER               ::   nct       ! Number of categories in field
79      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received
80   END TYPE FLD_CPL
81
82   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields
83
84   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving
85
86   !!----------------------------------------------------------------------
87   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
88   !! $Id$
89   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
90   !!----------------------------------------------------------------------
91CONTAINS
92
93   SUBROUTINE cpl_init( cd_modname, kl_comm )
94      !!-------------------------------------------------------------------
95      !!             ***  ROUTINE cpl_init  ***
96      !!
97      !! ** Purpose :   Initialize coupled mode communication for ocean
98      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
99      !!
100      !! ** Method  :   OASIS3 MPI communication
101      !!--------------------------------------------------------------------
102      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file
103      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model
104      !!--------------------------------------------------------------------
105
106      ! WARNING: No write in numout in this routine
107      !============================================
108
109      !------------------------------------------------------------------
110      ! 1st Initialize the OASIS system for the application
111      !------------------------------------------------------------------
112      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
113      IF ( nerror /= OASIS_Ok ) &
114         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
115
116      !------------------------------------------------------------------
117      ! 3rd Get an MPI communicator for OPA local communication
118      !------------------------------------------------------------------
119
120      CALL oasis_get_localcomm ( kl_comm, nerror )
121      IF ( nerror /= OASIS_Ok ) &
122         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
123      !
124   END SUBROUTINE cpl_init
125
126
127   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
128      !!-------------------------------------------------------------------
129      !!             ***  ROUTINE cpl_define  ***
130      !!
131      !! ** Purpose :   Define grid and field information for ocean
132      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
133      !!
134      !! ** Method  :   OASIS3 MPI communication
135      !!--------------------------------------------------------------------
136      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields
137      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
138      !
139      INTEGER :: id_part
140      INTEGER :: paral(5)       ! OASIS3 box partition
141      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
142      INTEGER :: ji,jc,jm       ! local loop indicees
143      CHARACTER(LEN=64) :: zclname
144      CHARACTER(LEN=2) :: cli2
145      !!--------------------------------------------------------------------
146
147      IF(lwp) WRITE(numout,*)
148      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
149      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
150      IF(lwp) WRITE(numout,*)
151
152      ncplmodel = kcplmodel
153      IF( kcplmodel > nmaxcpl ) THEN
154         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
155      ENDIF
156
157      nrcv = krcv
158      IF( nrcv > nmaxfld ) THEN
159         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN
160      ENDIF
161
162      nsnd = ksnd
163      IF( nsnd > nmaxfld ) THEN
164         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
165      ENDIF
166      !
167      ! ... Define the shape for the area that excludes the halo
168      !     For serial configuration (key_mpp_mpi not being active)
169      !     nl* is set to the global values 1 and jp*glo.
170      !
171      ishape(:,1) = (/ 1, nlei-nldi+1 /)
172      ishape(:,2) = (/ 1, nlej-nldj+1 /)
173      !
174      ! ... Allocate memory for data exchange
175      !
176      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
177      IF( nerror > 0 ) THEN
178         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN
179      ENDIF
180      !
181      ! -----------------------------------------------------------------
182      ! ... Define the partition
183      ! -----------------------------------------------------------------
184     
185      paral(1) = 2                                              ! box partitioning
186      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset   
187      paral(3) = nlei-nldi+1                                    ! local extent in i
188      paral(4) = nlej-nldj+1                                    ! local extent in j
189      paral(5) = jpiglo                                         ! global extent in x
190     
191      IF( ln_ctl ) THEN
192         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
193         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
194         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
195         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
196      ENDIF
197     
198      CALL oasis_def_partition ( id_part, paral, nerror )
199      !
200      ! ... Announce send variables.
201      !
202      ssnd(:)%ncplmodel = kcplmodel
203      !
204      DO ji = 1, ksnd
205         IF ( ssnd(ji)%laction ) THEN
206
207            IF( ssnd(ji)%nct > nmaxcat ) THEN
208               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
209                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
210               RETURN
211            ENDIF
212           
213            DO jc = 1, ssnd(ji)%nct
214               DO jm = 1, kcplmodel
215
216                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
217                     WRITE(cli2,'(i2.2)') jc
218                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
219                  ELSE
220                     zclname = ssnd(ji)%clname
221                  ENDIF
222                  IF ( kcplmodel  > 1 ) THEN
223                     WRITE(cli2,'(i2.2)') jm
224                     zclname = 'model'//cli2//'_'//TRIM(zclname)
225                  ENDIF
226#if defined key_agrif
227                  IF( agrif_fixed() /= 0 ) THEN
228                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
229                  END IF
230#endif
231                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
232                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
233                     &                OASIS_Out          , ishape , OASIS_REAL, nerror )
234                  IF ( nerror /= OASIS_Ok ) THEN
235                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
236                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
237                  ENDIF
238                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
239                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
240               END DO
241            END DO
242         ENDIF
243      END DO
244      !
245      ! ... Announce received variables.
246      !
247      srcv(:)%ncplmodel = kcplmodel
248      !
249      DO ji = 1, krcv
250         IF ( srcv(ji)%laction ) THEN
251           
252            IF( srcv(ji)%nct > nmaxcat ) THEN
253               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
254                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
255               RETURN
256            ENDIF
257           
258            DO jc = 1, srcv(ji)%nct
259               DO jm = 1, kcplmodel
260                 
261                  IF ( srcv(ji)%nct .GT. 1 ) THEN
262                     WRITE(cli2,'(i2.2)') jc
263                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
264                  ELSE
265                     zclname = srcv(ji)%clname
266                  ENDIF
267                  IF ( kcplmodel  > 1 ) THEN
268                     WRITE(cli2,'(i2.2)') jm
269                     zclname = 'model'//cli2//'_'//TRIM(zclname)
270                  ENDIF
271#if defined key_agrif
272                  IF( agrif_fixed() /= 0 ) THEN
273                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
274                  END IF
275#endif
276                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
277                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
278                     &                OASIS_In           , ishape , OASIS_REAL, nerror )
279                  IF ( nerror /= OASIS_Ok ) THEN
280                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
281                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
282                  ENDIF
283                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
284                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
285
286               END DO
287            END DO
288         ENDIF
289      END DO
290     
291      !------------------------------------------------------------------
292      ! End of definition phase
293      !------------------------------------------------------------------
294     
295      CALL oasis_enddef(nerror)
296      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
297      !
298   END SUBROUTINE cpl_define
299   
300   
301   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
302      !!---------------------------------------------------------------------
303      !!              ***  ROUTINE cpl_snd  ***
304      !!
305      !! ** Purpose : - At each coupling time-step,this routine sends fields
306      !!      like sst or ice cover to the coupler or remote application.
307      !!----------------------------------------------------------------------
308      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
309      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
310      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
311      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
312      !!
313      INTEGER                                   ::   jc,jm     ! local loop index
314      !!--------------------------------------------------------------------
315      !
316      ! snd data to OASIS3
317      !
318      DO jc = 1, ssnd(kid)%nct
319         DO jm = 1, ssnd(kid)%ncplmodel
320       
321            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
322               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
323               
324               IF ( ln_ctl ) THEN       
325                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
326                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
327                     WRITE(numout,*) '****************'
328                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
329                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
330                     WRITE(numout,*) 'oasis_put:  kstep ', kstep
331                     WRITE(numout,*) 'oasis_put:   info ', kinfo
332                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
333                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
334                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
335                     WRITE(numout,*) '****************'
336                  ENDIF
337               ENDIF
338               
339            ENDIF
340           
341         ENDDO
342      ENDDO
343      !
344    END SUBROUTINE cpl_snd
345
346
347   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
348      !!---------------------------------------------------------------------
349      !!              ***  ROUTINE cpl_rcv  ***
350      !!
351      !! ** Purpose : - At each coupling time-step,this routine receives fields
352      !!      like stresses and fluxes from the coupler or remote application.
353      !!----------------------------------------------------------------------
354      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
355      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
356      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
357      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask
358      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
359      !!
360      INTEGER                                   ::   jc,jm     ! local loop index
361      LOGICAL                                   ::   llaction, llfisrt
362      !!--------------------------------------------------------------------
363      !
364      ! receive local data from OASIS3 on every process
365      !
366      kinfo = OASIS_idle
367      !
368      DO jc = 1, srcv(kid)%nct
369         llfisrt = .TRUE.
370
371         DO jm = 1, srcv(kid)%ncplmodel
372
373            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
374
375               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )         
376               
377               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
378                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
379               
380               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
381               
382               IF ( llaction ) THEN
383                 
384                  kinfo = OASIS_Rcv
385                  IF( llfisrt ) THEN
386                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
387                     llfisrt = .FALSE.
388                  ELSE
389                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
390                  ENDIF
391                 
392                  IF ( ln_ctl ) THEN       
393                     WRITE(numout,*) '****************'
394                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
395                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm)
396                     WRITE(numout,*) 'oasis_get:   kstep', kstep
397                     WRITE(numout,*) 'oasis_get:   info ', kinfo
398                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
399                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
400                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
401                     WRITE(numout,*) '****************'
402                  ENDIF
403                 
404               ENDIF
405               
406            ENDIF
407           
408         ENDDO
409
410         !--- Fill the overlap areas and extra hallows (mpp)
411         !--- check periodicity conditions (all cases)
412         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
413 
414      ENDDO
415      !
416   END SUBROUTINE cpl_rcv
417
418
419   INTEGER FUNCTION cpl_freq( cdfieldname ) 
420      !!---------------------------------------------------------------------
421      !!              ***  ROUTINE cpl_freq  ***
422      !!
423      !! ** Purpose : - send back the coupling frequency for a particular field
424      !!----------------------------------------------------------------------
425      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
426      !!
427      INTEGER               :: id
428      INTEGER               :: info
429      INTEGER, DIMENSION(1) :: itmp
430      INTEGER               :: ji,jm     ! local loop index
431      INTEGER               :: mop
432      !!----------------------------------------------------------------------
433      cpl_freq = 0   ! defaut definition
434      id = -1        ! defaut definition
435      !
436      DO ji = 1, nsnd
437         IF (ssnd(ji)%laction ) THEN
438            DO jm = 1, ncplmodel
439               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
440                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
441                     id = ssnd(ji)%nid(1,jm)
442                     mop = OASIS_Out
443                  ENDIF
444               ENDIF
445            ENDDO
446         ENDIF
447      ENDDO
448      DO ji = 1, nrcv
449         IF (srcv(ji)%laction ) THEN
450            DO jm = 1, ncplmodel
451               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
452                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
453                     id = srcv(ji)%nid(1,jm)
454                     mop = OASIS_In
455                  ENDIF
456               ENDIF
457            ENDDO
458         ENDIF
459      ENDDO
460      !
461      IF( id /= -1 ) THEN
462#if defined key_oa3mct_v3
463         CALL oasis_get_freqs(id, mop, 1, itmp, info)
464#else
465         CALL oasis_get_freqs(id,      1, itmp, info)
466#endif
467         cpl_freq = itmp(1)
468      ENDIF
469      !
470   END FUNCTION cpl_freq
471
472
473   SUBROUTINE cpl_finalize
474      !!---------------------------------------------------------------------
475      !!              ***  ROUTINE cpl_finalize  ***
476      !!
477      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
478      !!      called explicitly before cpl_init it will also close
479      !!      MPI communication.
480      !!----------------------------------------------------------------------
481      !
482      DEALLOCATE( exfld )
483      IF (nstop == 0) THEN
484         CALL oasis_terminate( nerror )         
485      ELSE
486         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
487      ENDIF       
488      !
489   END SUBROUTINE cpl_finalize
490
491#if ! defined key_oasis3
492
493   !!----------------------------------------------------------------------
494   !!   No OASIS Library          OASIS3 Dummy module...
495   !!----------------------------------------------------------------------
496
497   SUBROUTINE oasis_init_comp(k1,cd1,k2)
498      CHARACTER(*), INTENT(in   ) ::  cd1
499      INTEGER     , INTENT(  out) ::  k1,k2
500      k1 = -1 ; k2 = -1
501      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
502   END SUBROUTINE oasis_init_comp
503
504   SUBROUTINE oasis_abort(k1,cd1,cd2)
505      INTEGER     , INTENT(in   ) ::  k1
506      CHARACTER(*), INTENT(in   ) ::  cd1,cd2
507      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
508   END SUBROUTINE oasis_abort
509
510   SUBROUTINE oasis_get_localcomm(k1,k2)
511      INTEGER     , INTENT(  out) ::  k1,k2
512      k1 = -1 ; k2 = -1
513      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
514   END SUBROUTINE oasis_get_localcomm
515
516   SUBROUTINE oasis_def_partition(k1,k2,k3)
517      INTEGER     , INTENT(  out) ::  k1,k3
518      INTEGER     , INTENT(in   ) ::  k2(5)
519      k1 = k2(1) ; k3 = k2(5)
520      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
521   END SUBROUTINE oasis_def_partition
522
523   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
524      CHARACTER(*), INTENT(in   ) ::  cd1
525      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6
526      INTEGER     , INTENT(  out) ::  k1,k7
527      k1 = -1 ; k7 = -1
528      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
529   END SUBROUTINE oasis_def_var
530
531   SUBROUTINE oasis_enddef(k1)
532      INTEGER     , INTENT(  out) ::  k1
533      k1 = -1
534      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
535   END SUBROUTINE oasis_enddef
536 
537   SUBROUTINE oasis_put(k1,k2,p1,k3)
538      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1
539      INTEGER                 , INTENT(in   ) ::  k1,k2
540      INTEGER                 , INTENT(  out) ::  k3
541      k3 = -1
542      WRITE(numout,*) 'oasis_put: Error you sould not be there...'
543   END SUBROUTINE oasis_put
544
545   SUBROUTINE oasis_get(k1,k2,p1,k3)
546      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1
547      INTEGER                 , INTENT(in   ) ::  k1,k2
548      INTEGER                 , INTENT(  out) ::  k3
549      p1(1,1) = -1. ; k3 = -1
550      WRITE(numout,*) 'oasis_get: Error you sould not be there...'
551   END SUBROUTINE oasis_get
552
553   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
554      INTEGER              , INTENT(in   ) ::  k1,k2
555      INTEGER, DIMENSION(1), INTENT(  out) ::  k3
556      INTEGER              , INTENT(  out) ::  k4
557      k3(1) = k1 ; k4 = k2
558      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
559   END SUBROUTINE oasis_get_freqs
560
561   SUBROUTINE oasis_terminate(k1)
562      INTEGER     , INTENT(  out) ::  k1
563      k1 = -1
564      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
565   END SUBROUTINE oasis_terminate
566   
567#endif
568
569   !!=====================================================================
570END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.