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

source: branches/UKMO/nemo_v3_6_STABLE_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 6254

Last change on this file since 6254 was 6254, checked in by frrh, 8 years ago

Merge branches/UKMO/dev_r5107_hadgem3_mct@5679 (not 5631 as used in
original GO6.1 which I was supplied with! This has extra, meaningful,
error trapping in place of the original inappropriate use of "STOP"
which is useless in the context of coupled models.

Again merging this branch proved far more awkward than it should
be with spurious claims of conflicts in various irrelevant files
in NEMOGCM/ARCH/ and DOC/TexFiles which I reverted before committing.
File size: 28.7 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     
215      paral(1) = 2                                              ! box partitioning
216      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset   
217      paral(3) = nlei-nldi+1                                    ! local extent in i
218      paral(4) = nlej-nldj+1                                    ! local extent in j
219      paral(5) = jpiglo                                         ! global extent in x
220     
221      IF( ln_ctl ) THEN
222         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
223         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
224         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
225         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
226      ENDIF
227     
228      ENDIF
229      IF ( commRank )  CALL oasis_def_partition ( id_part, paral, nerror )
230     
231      ! ... Allocate memory for data exchange
232      !
233      ALLOCATE(exfld(paral(3), paral(4)), stat = nerror)
234      IF( nerror > 0 ) THEN
235         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN
236      ENDIF
237      IF ( rootexchg ) THEN
238! Should possibly use one of the work arrays for tbuf really
239         ALLOCATE(tbuf(jpi, jpj, jpnij), stat = nerror)
240         IF( nerror > 0 ) THEN
241             CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating tbuf') ; RETURN
242         ENDIF
243       ENDIF             
244       !
245       IF (commRank ) THEN
246      !
247      ! ... Announce send variables.
248      !
249      ssnd(:)%ncplmodel = kcplmodel
250      !
251      DO ji = 1, ksnd
252         IF ( ssnd(ji)%laction ) THEN
253
254            IF( ssnd(ji)%nct > nmaxcat ) THEN
255               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
256                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
257               RETURN
258            ENDIF
259           
260            DO jc = 1, ssnd(ji)%nct
261               DO jm = 1, kcplmodel
262
263                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
264                     WRITE(cli2,'(i2.2)') jc
265                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
266                  ELSE
267                     zclname = ssnd(ji)%clname
268                  ENDIF
269                  IF ( kcplmodel  > 1 ) THEN
270                     WRITE(cli2,'(i2.2)') jm
271                     zclname = 'model'//cli2//'_'//TRIM(zclname)
272                  ENDIF
273#if defined key_agrif
274                  IF( agrif_fixed() /= 0 ) THEN
275                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
276                  END IF
277#endif
278                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
279                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
280                     &                OASIS_Out          , ishape , OASIS_REAL, nerror )
281                  IF ( nerror /= OASIS_Ok ) THEN
282                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
283                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
284                  ENDIF
285                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
286                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
287               END DO
288            END DO
289         ENDIF
290      END DO     
291      !
292      ! ... Announce received variables.
293      !
294      srcv(:)%ncplmodel = kcplmodel
295      !
296      DO ji = 1, krcv
297         IF ( srcv(ji)%laction ) THEN
298           
299            IF( srcv(ji)%nct > nmaxcat ) THEN
300               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
301                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
302               RETURN
303            ENDIF
304           
305            DO jc = 1, srcv(ji)%nct
306               DO jm = 1, kcplmodel
307                 
308                  IF ( srcv(ji)%nct .GT. 1 ) THEN
309                     WRITE(cli2,'(i2.2)') jc
310                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
311                  ELSE
312                     zclname = srcv(ji)%clname
313                  ENDIF
314                  IF ( kcplmodel  > 1 ) THEN
315                     WRITE(cli2,'(i2.2)') jm
316                     zclname = 'model'//cli2//'_'//TRIM(zclname)
317                  ENDIF
318#if defined key_agrif
319                  IF( agrif_fixed() /= 0 ) THEN
320                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
321                  END IF
322#endif
323                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
324                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
325                     &                OASIS_In           , ishape , OASIS_REAL, nerror )
326                  IF ( nerror /= OASIS_Ok ) THEN
327                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
328                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
329                  ENDIF
330                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
331                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
332
333               END DO
334            END DO
335         ENDIF
336      END DO
337      !
338      ENDIF  ! commRank=true
339     
340      !------------------------------------------------------------------
341      ! End of definition phase
342      !------------------------------------------------------------------
343     
344      IF ( commRank ) THEN     
345     
346         CALL oasis_enddef(nerror)
347         IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
348      ENDIF
349      !
350   END SUBROUTINE cpl_define
351   
352   
353   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
354      !!---------------------------------------------------------------------
355      !!              ***  ROUTINE cpl_snd  ***
356      !!
357      !! ** Purpose : - At each coupling time-step,this routine sends fields
358      !!      like sst or ice cover to the coupler or remote application.
359      !!----------------------------------------------------------------------
360      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
361      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
362      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
363      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
364      !!
365      INTEGER                                   ::   jn,jc,jm     ! local loop index
366      !!--------------------------------------------------------------------
367      !
368      ! snd data to OASIS3
369      !
370      DO jc = 1, ssnd(kid)%nct
371         DO jm = 1, ssnd(kid)%ncplmodel
372       
373            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
374               IF ( rootexchg ) THEN
375                  !
376                  ! collect data on the local root process
377                  !
378                  CALL mppgather (pdata(:,:,jc),localRoot,tbuf) 
379                  CALL mppsync 
380           
381                  IF ( nproc == localRoot ) THEN
382                               
383                     DO jn = 1, jpnij
384                        exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1)= &
385                          tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn)
386                     ENDDO
387               
388                     ! snd data to OASIS3
389                     CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, exfld, kinfo )
390           
391                  ENDIF
392           
393               ELSE
394
395                   ! snd data to OASIS3
396                   CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
397               ENDIF
398               
399               IF ( ln_ctl ) THEN       
400                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
401                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
402                     WRITE(numout,*) '****************'
403                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
404                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
405                     WRITE(numout,*) 'oasis_put:  kstep ', kstep
406                     WRITE(numout,*) 'oasis_put:   info ', kinfo
407                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
408                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
409                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
410                     WRITE(numout,*) '****************'
411                  ENDIF
412               ENDIF
413               
414            ENDIF
415           
416         ENDDO
417      ENDDO
418      !
419    END SUBROUTINE cpl_snd
420
421
422   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
423      !!---------------------------------------------------------------------
424      !!              ***  ROUTINE cpl_rcv  ***
425      !!
426      !! ** Purpose : - At each coupling time-step,this routine receives fields
427      !!      like stresses and fluxes from the coupler or remote application.
428      !!----------------------------------------------------------------------
429      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
430      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
431      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
432      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask
433      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
434      !!
435      INTEGER                                   ::   jn,jc,jm     ! local loop index
436      LOGICAL                                   ::   llaction, llfisrt
437      !!--------------------------------------------------------------------
438      !
439      ! receive local data from OASIS3 on every process
440      !
441      kinfo = OASIS_idle
442      !
443      DO jc = 1, srcv(kid)%nct
444         llfisrt = .TRUE.
445
446         DO jm = 1, srcv(kid)%ncplmodel
447
448            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
449               
450               !
451               ! receive data from OASIS3
452               !
453               IF ( commRank )  CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )
454       
455               IF ( rootexchg )  CALL MPI_BCAST ( kinfo, 1, MPI_INTEGER, localRoot, localComm, nerror )                     
456               
457               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
458                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
459               
460               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
461               
462               IF ( llaction ) THEN
463                 
464                  kinfo = OASIS_Rcv
465                  IF( llfisrt ) THEN
466                     
467                     IF ( rootexchg ) THEN
468           
469                        ! distribute data to processes
470                        !
471                        IF ( nproc == localRoot ) THEN
472
473                           DO jn = 1, jpnij
474                              tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn)=          &
475                              exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1)
476                              ! NOTE: we are missing combining this with pmask (see else below)
477                           ENDDO
478               
479                        ENDIF
480
481                        CALL mppscatter (tbuf,localRoot,pdata(:,:,jc)) 
482                        CALL mppsync
483
484                     ELSE
485           
486                        pdata(nldi:nlei, nldj:nlej, jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
487               
488                     ENDIF
489                     
490                     llfisrt = .FALSE.
491                  ELSE
492                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
493                  ENDIF
494                 
495                  IF ( ln_ctl ) THEN       
496                     WRITE(numout,*) '****************'
497                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
498                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm)
499                     WRITE(numout,*) 'oasis_get:   kstep', kstep
500                     WRITE(numout,*) 'oasis_get:   info ', kinfo
501                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
502                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
503                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
504                     WRITE(numout,*) '****************'
505                  ENDIF
506                 
507               ENDIF
508               
509            ENDIF
510           
511         ENDDO
512
513         !--- Fill the overlap areas and extra hallows (mpp)
514         !--- check periodicity conditions (all cases)
515         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
516 
517      ENDDO
518      !
519   END SUBROUTINE cpl_rcv
520
521
522   INTEGER FUNCTION cpl_freq( cdfieldname ) 
523      !!---------------------------------------------------------------------
524      !!              ***  ROUTINE cpl_freq  ***
525      !!
526      !! ** Purpose : - send back the coupling frequency for a particular field
527      !!----------------------------------------------------------------------
528      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
529      !!
530      INTEGER               :: id
531      INTEGER               :: info
532      INTEGER, DIMENSION(1) :: itmp
533      INTEGER               :: ji,jm     ! local loop index
534      INTEGER               :: mop
535      !!----------------------------------------------------------------------
536      cpl_freq = 0   ! defaut definition
537      id = -1        ! defaut definition
538      !
539      DO ji = 1, nsnd
540         IF (ssnd(ji)%laction ) THEN
541            DO jm = 1, ncplmodel
542               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
543                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
544                     id = ssnd(ji)%nid(1,jm)
545                     mop = OASIS_Out
546                  ENDIF
547               ENDIF
548            ENDDO
549         ENDIF
550      ENDDO
551      DO ji = 1, nrcv
552         IF (srcv(ji)%laction ) THEN
553            DO jm = 1, ncplmodel
554               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
555                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
556                     id = srcv(ji)%nid(1,jm)
557                     mop = OASIS_In
558                  ENDIF
559               ENDIF
560            ENDDO
561         ENDIF
562      ENDDO
563      !
564      IF( id /= -1 ) THEN
565#if defined key_oa3mct_v3
566         CALL oasis_get_freqs(id, mop, 1, itmp, info)
567#endif
568#if defined key_oasis3
569         CALL oasis_get_freqs(id,      1, itmp, info)
570#endif
571         cpl_freq = itmp(1)
572#if defined key_oasis3mct
573         cpl_freq = namflddti( id )
574#endif
575      ENDIF
576      !
577   END FUNCTION cpl_freq
578
579
580   SUBROUTINE cpl_finalize
581      !!---------------------------------------------------------------------
582      !!              ***  ROUTINE cpl_finalize  ***
583      !!
584      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
585      !!      called explicitly before cpl_init it will also close
586      !!      MPI communication.
587      !!----------------------------------------------------------------------
588      !
589      DEALLOCATE( exfld )
590      IF ( rootexchg ) DEALLOCATE ( tbuf )
591      IF (nstop == 0) THEN
592         CALL oasis_terminate( nerror )         
593      ELSE
594         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
595      ENDIF       
596      !
597   END SUBROUTINE cpl_finalize
598
599#if ! defined key_oasis3 && ! defined key_oasis3mct
600
601   !!----------------------------------------------------------------------
602   !!   No OASIS Library          OASIS3 Dummy module...
603   !!----------------------------------------------------------------------
604
605   SUBROUTINE oasis_init_comp(k1,cd1,k2)
606      CHARACTER(*), INTENT(in   ) ::  cd1
607      INTEGER     , INTENT(  out) ::  k1,k2
608      k1 = -1 ; k2 = -1
609      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
610   END SUBROUTINE oasis_init_comp
611
612   SUBROUTINE oasis_abort(k1,cd1,cd2)
613      INTEGER     , INTENT(in   ) ::  k1
614      CHARACTER(*), INTENT(in   ) ::  cd1,cd2
615      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
616   END SUBROUTINE oasis_abort
617
618   SUBROUTINE oasis_get_localcomm(k1,k2)
619      INTEGER     , INTENT(  out) ::  k1,k2
620      k1 = -1 ; k2 = -1
621      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
622   END SUBROUTINE oasis_get_localcomm
623
624   SUBROUTINE oasis_def_partition(k1,k2,k3)
625      INTEGER     , INTENT(  out) ::  k1,k3
626      INTEGER     , INTENT(in   ) ::  k2(5)
627      k1 = k2(1) ; k3 = k2(5)
628      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
629   END SUBROUTINE oasis_def_partition
630
631   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
632      CHARACTER(*), INTENT(in   ) ::  cd1
633      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6
634      INTEGER     , INTENT(  out) ::  k1,k7
635      k1 = -1 ; k7 = -1
636      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
637   END SUBROUTINE oasis_def_var
638
639   SUBROUTINE oasis_enddef(k1)
640      INTEGER     , INTENT(  out) ::  k1
641      k1 = -1
642      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
643   END SUBROUTINE oasis_enddef
644 
645   SUBROUTINE oasis_put(k1,k2,p1,k3)
646      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1
647      INTEGER                 , INTENT(in   ) ::  k1,k2
648      INTEGER                 , INTENT(  out) ::  k3
649      k3 = -1
650      WRITE(numout,*) 'oasis_put: Error you sould not be there...'
651   END SUBROUTINE oasis_put
652
653   SUBROUTINE oasis_get(k1,k2,p1,k3)
654      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1
655      INTEGER                 , INTENT(in   ) ::  k1,k2
656      INTEGER                 , INTENT(  out) ::  k3
657      p1(1,1) = -1. ; k3 = -1
658      WRITE(numout,*) 'oasis_get: Error you sould not be there...'
659   END SUBROUTINE oasis_get
660
661   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
662      INTEGER              , INTENT(in   ) ::  k1,k2
663      INTEGER, DIMENSION(1), INTENT(  out) ::  k3
664      INTEGER              , INTENT(  out) ::  k4
665      k3(1) = k1 ; k4 = k2
666      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
667   END SUBROUTINE oasis_get_freqs
668
669   SUBROUTINE oasis_terminate(k1)
670      INTEGER     , INTENT(  out) ::  k1
671      k1 = -1
672      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
673   END SUBROUTINE oasis_terminate
674   
675#endif
676
677   !!=====================================================================
678END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.