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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
cpl_oasis3.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 10396

Last change on this file since 10396 was 10392, checked in by jcastill, 5 years ago

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