source: NEMO/trunk/src/OCE/SBC/cpl_oasis3.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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