frame/module_cpl_oasis3.F

   1  MODULE module_cpl_oasis3
   2 #ifdef key_cpp_oasis3
   3    !!======================================================================
   4    !!                    ***  MODULE cpl_oasis  ***
   5    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
   6    !!=====================================================================
   7    !!----------------------------------------------------------------------
   8    !!   cpl_oasis_init     : initialization of coupled mode communication
   9    !!   cpl_oasis_define   : definition of grid and fields
  10    !!   cpl_oasis_snd      : send out fields in coupled mode
  11    !!   cpl_oasis_rcv      : receive fields in coupled mode
  12    !!   cpl_oasis_finaliz : finalize the coupled mode communication
  13    !!----------------------------------------------------------------------
  14
  15    USE module_domain          , ONLY : domain, get_ijk_from_grid
  16    USE module_driver_constants, ONLY : max_domains, max_cplfld, max_extdomains
  17    USE mod_oasis              ! OASIS3-MCT module
  18
  19    IMPLICIT NONE
  20    PRIVATE
  21
  22    TYPE ::   FLD_CPL                                  ! Coupling field information
  23       CHARACTER(len = 64) ::   clname                    ! Name of the coupling field, jpeighty defined in oasis
  24       INTEGER             ::   nid                       ! Id of the field
  25 #if ( RWORDSIZE == 8 )
  26       REAL        , POINTER, DIMENSION(:,:) ::   dbl2d   ! 2d array to store received field
  27 #else
  28       REAL(kind=8), POINTER, DIMENSION(:,:) ::   dbl2d   ! 2d array to store received field
  29 #endif
  30    END TYPE FLD_CPL
  31    TYPE(FLD_CPL), DIMENSION(max_domains,max_extdomains,max_cplfld) :: srcv, ssnd   ! Coupling fields informations
  32    INTEGER :: ndm_comm                                                         ! MPI communicator between the computing nodes
  33    INTEGER :: ncomp_id                                                         ! id returned by oasis_init_comp
  34    INTEGER :: nlevdbg  = 1                                                     ! verbosity level
  35    INTEGER :: nlevdbg2 = 10                                                    ! verbosity level
  36    CHARACTER(len = 256) :: cltxt                                               ! messages or debug string
  37
  38    !! Routine accessibility
  39    PUBLIC cpl_oasis_init
  40    PUBLIC cpl_oasis_def_dmcomm
  41    PUBLIC cpl_oasis_define
  42    PUBLIC cpl_oasis_toreceive
  43    PUBLIC cpl_oasis_tosend
  44    PUBLIC cpl_oasis_snd
  45    PUBLIC cpl_oasis_rcv
  46    PUBLIC cpl_oasis_finalize
  47    PUBLIC cpl_oasis_abort
  48
  49 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
  50    INCLUDE 'mpif.h'               ! only for MPI_COMM_NULL
  51 #else
  52    INTEGER :: MPI_COMM_NULL = -1  ! define a fake (and not used) MPI_COMM_NULL, so it is compiling
  53 #endif
  54
  55 CONTAINS
  56
  57    SUBROUTINE cpl_oasis_init( kl_comm )
  58       !!-------------------------------------------------------------------
  59       !!             ***  ROUTINE cpl_oasis_init  ***
  60       !!
  61       !! ** Purpose :   Initialize coupled mode communication for WRF
  62       !!--------------------------------------------------------------------
  63       INTEGER, INTENT(OUT) :: kl_comm       ! local communicator of the model
  64       !
  65       INTEGER :: ierror   ! return error code
  66       !!--------------------------------------------------------------------
  67
  68       ! Initialize OASIS for the application
  69       CALL oasis_init_comp( ncomp_id, 'wrfexe', ierror )
  70       IF( ierror /= OASIS_Ok )   CALL cpl_oasis_abort( 'cpl_oasis_init', 'Failure in oasis_init_comp' )
  71
  72       ! Get an MPI communicator for WRF local communication
  73       CALL oasis_get_localcomm( kl_comm, ierror )
  74       IF( ierror /= OASIS_Ok )   CALL cpl_oasis_abort( 'cpl_oasis_init','Failure in oasis_get_localcomm' )
  75
  76       srcv(:,:,:)%nid = -1            ! default definition
  77       ssnd(:,:,:)%nid = -1            ! default definition
  78       ndm_comm        = MPI_COMM_NULL ! default definition, will be redefined by cpl_oasis_def_dmcomm if computing node
  79
  80    END SUBROUTINE cpl_oasis_init
  81
  82
  83    SUBROUTINE cpl_oasis_def_dmcomm( kdm_comm )
  84       !!-------------------------------------------------------------------
  85       !!             ***  ROUTINE cpl_oasis_def_dmcomm  ***
  86       !!
  87       !! ** Purpose :   define ndm_comm: the MPI communicator between the computing nodes
  88       !!--------------------------------------------------------------------
  89       INTEGER, INTENT(IN) :: kdm_comm       ! computing nodes communicator
  90       !!--------------------------------------------------------------------
  91       ndm_comm = kdm_comm   ! store it to used it in cpl_oasis_define
  92
  93       WRITE(cltxt,*) 'cpl_oasis_def_dmcomm : ', kdm_comm
  94       CALL wrf_debug(nlevdbg, cltxt)
  95       CALL wrf_debug(nlevdbg, '~~~~~~~~~~~~~~~~~~~~~~~')
  96
  97    END SUBROUTINE cpl_oasis_def_dmcomm
  98
  99
 100    SUBROUTINE cpl_oasis_define( cdsndname, cdrcvname, pgrid )
 101       !!-------------------------------------------------------------------
 102       !!             ***  ROUTINE cpl_oasis_define  ***
 103       !!
 104       !! ** Purpose :   Define grid and coupling field information for WRF
 105       !!--------------------------------------------------------------------
 106       CHARACTER(*), INTENT(IN), DIMENSION(:,:,:)  :: cdsndname, cdrcvname   ! coupling field names
 107       TYPE(domain), INTENT(IN), OPTIONAL, POINTER :: pgrid                  ! grid structure
 108       !
 109       INTEGER :: ierror                  ! return error code
 110       INTEGER :: idwrf1,idwrf2           ! loop index over wrf domain number (start and end)
 111       INTEGER :: idext1,idext2           ! loop index over external model domain number (start and end)
 112       INTEGER :: id_part                 ! partition id in oasis
 113       INTEGER :: iparal(5)               ! OASIS box partition
 114       INTEGER :: ishape(2,2)             ! shape of arrays passed to PSMILe
 115       INTEGER :: jw,je,jf                ! local loop indicees
 116       INTEGER :: ips,ipe,jps,jpe,kps,kpe ! domain dimension on 1 processor
 117       INTEGER :: ims,ime,jms,jme,kms,kme ! memory domain dimension on 1 processor
 118       INTEGER :: ids,ide,jds,jde,kds,kde ! domain dimension
 119       LOGICAL :: llcompute_core          ! is it a compiting core?
 120       !!--------------------------------------------------------------------
 121
 122       CALL wrf_message('cpl_oasis_define : initialization in coupled ocean/atmosphere case')
 123       CALL wrf_debug(nlevdbg, '~~~~~~~~~~~~~~~~~~~~~~~')
 124
 125       llcompute_core = PRESENT(pgrid)
 126
 127       ! -----------------------------------------------------------------
 128       ! ... Define communicator used between computing cores
 129       CALL oasis_set_couplcomm( ndm_comm, ierror )               ! provide this communicator to OASIS3-MCT
 130       IF ( ierror /= OASIS_Ok ) CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in oasis_set_couplcomm')
 131
 132       ! -----------------------------------------------------------------
 133       ! ... Define the partition
 134       ! -----------------------------------------------------------------
 135       IF( llcompute_core ) THEN
 136
 137          ! ... get mpi domain position
 138          CALL get_ijk_from_grid( pgrid, ids, ide, jds, jde, kds, kde, &
 139             &                           ims, ime, jms, jme, kms, kme, &
 140             &                           ips, ipe, jps, jpe, kps, kpe  )
 141
 142          ishape(:,1) = (/1, ipe-ips+1 /)
 143          ishape(:,2) = (/1, jpe-jps+1 /)
 144
 145          ! ... Define the partition parameteres
 146          iparal(1) = 2                                      ! box partitioning
 147          iparal(2) = ide * ( jps - 1 ) + (ips -1)
 148          iparal(3) = ipe - ips + 1                          ! local extent in i
 149          iparal(4) = jpe - jps + 1                          ! local extent in j
 150          iparal(5) = ide                                    ! global extent in x
 151
 152          WRITE(cltxt,*) 'Define the partition for computing cores'   ;   CALL wrf_debug(nlevdbg, cltxt)
 153          WRITE(cltxt,*) ' multiexchg: iparal (1:5)', iparal          ;   CALL wrf_debug(nlevdbg, cltxt)
 154          WRITE(cltxt,*) ' multiexchg: ips, ipe =', ips, ipe          ;   CALL wrf_debug(nlevdbg, cltxt)
 155          WRITE(cltxt,*) ' multiexchg: jps, jpe =', jps, jpe          ;   CALL wrf_debug(nlevdbg, cltxt)
 156          WRITE(cltxt,*) ' multiexchg: ids, jds =', ids, jds          ;   CALL wrf_debug(nlevdbg, cltxt)
 157          WRITE(cltxt,*) ' multiexchg: ide, jde =', ide, jde          ;   CALL wrf_debug(nlevdbg, cltxt)
 158          WRITE(cltxt,*) ' multiexchg: ishape(:,1) =', ishape(:,1)    ;   CALL wrf_debug(nlevdbg, cltxt)
 159          WRITE(cltxt,*) ' multiexchg: ishape(:,2) =', ishape(:,2)    ;   CALL wrf_debug(nlevdbg, cltxt)
 160
 161       ELSE
 162          CALL wrf_debug(nlevdbg, 'no partition for IO cores')
 163          iparal(:) = 0   ! "fake" partition for IO cores
 164       ENDIF
 165
 166       CALL oasis_def_partition( id_part, iparal, ierror )
 167       IF( ierror /= OASIS_Ok ) CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in oasis_def_partition')
 168
 169       ! -----------------------------------------------------------------
 170       ! ... Define the variables that can be send/received by WRF
 171       ! -----------------------------------------------------------------
 172       IF( llcompute_core ) THEN   ;   idwrf1 = pgrid%id   ;   idwrf2 = pgrid%id      ! coupling field related to this nest
 173       ELSE                        ;   idwrf1 = 1          ;   idwrf2 = max_domains   ! define all (dummy) coupling fields
 174       ENDIF
 175
 176       ! -----------------------------------------------------------------
 177       ! ... Define sent variables.
 178       ! -----------------------------------------------------------------
 179       DO jf = 1, max_cplfld
 180          DO je = 1, max_extdomains
 181             DO jw = idwrf1, idwrf2
 182                ssnd(jw,je,jf)%clname = TRIM(cdsndname(jw,je,jf))
 183                CALL oasis_def_var(ssnd(jw,je,jf)%nid, ssnd(jw,je,jf)%clname, id_part, (/2,1/), OASIS_Out, ishape, OASIS_Real,ierror)
 184                IF( ierror /= OASIS_Ok ) THEN
 185                   WRITE(cltxt,*) 'wrf domain ',jw,' external model domain ',je,   &
 186                      ' field ',jf,' (',TRIM(ssnd(jw,je,jf)%clname),'): oasis_def_var failed'
 187                   CALL wrf_message( cltxt )
 188                   CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in oasis_def_var')
 189                ENDIF
 190                WRITE(cltxt,*) 'cpl_oasis_define ok for :', TRIM(ssnd(jw,je,jf)%clname), ssnd(jw,je,jf)%nid
 191                CALL wrf_debug(nlevdbg2, cltxt)
 192                IF( ssnd(jw,je,jf)%nid /= -1 ) THEN
 193                   WRITE(cltxt,*) ' var snd: ', ssnd(jw,je,jf)%nid, ' ', TRIM(ssnd(jw,je,jf)%clname), id_part
 194                   CALL wrf_debug(nlevdbg, cltxt)
 195                ENDIF
 196             END DO
 197          END DO
 198       END DO
 199
 200       ! -----------------------------------------------------------------
 201       ! ... Define received variables.
 202       ! -----------------------------------------------------------------
 203       DO jf = 1, max_cplfld
 204          DO je = 1, max_extdomains
 205             DO jw = idwrf1, idwrf2
 206                srcv(jw,je,jf)%clname = TRIM(cdrcvname(jw,je,jf))
 207                CALL oasis_def_var(srcv(jw,je,jf)%nid, srcv(jw,je,jf)%clname, id_part, (/2,1/), OASIS_In , ishape, OASIS_Real,ierror)
 208                IF( ierror /= OASIS_Ok ) THEN
 209                   WRITE(cltxt,*) 'wrf domain ',jw,' external model domain ',je,   &
 210                      ' field ',jf,' (',TRIM(srcv(jw,je,jf)%clname),'): oasis_def_var failed'
 211                   CALL wrf_message( cltxt )
 212                   CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in oasis_def_var')
 213                ENDIF
 214                WRITE(cltxt,*) 'cpl_oasis_define ok for :', TRIM(srcv(jw,je,jf)%clname), srcv(jw,je,jf)%nid
 215                CALL wrf_debug(nlevdbg2, cltxt)
 216                IF( srcv(jw,je,jf)%nid /= -1 ) THEN
 217                   WRITE(cltxt,*) ' var rcv: ', srcv(jw,je,jf)%nid, ' ', TRIM(srcv(jw,je,jf)%clname), id_part
 218                   CALL wrf_debug(nlevdbg, cltxt)
 219                END IF
 220                IF( srcv(jw,je,jf)%nid /= -1 .AND. llcompute_core ) THEN   ! allocate received array
 221                   ALLOCATE( srcv(jw,je,jf)%dbl2d( iparal(3), iparal(4) ), stat = ierror)
 222                   IF (ierror > 0)   CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in allocating srcv')
 223                END IF
 224             END DO
 225          END DO
 226       END DO
 227
 228       ! -----------------------------------------------------------------
 229       ! ... End definition
 230       ! -----------------------------------------------------------------
 231       IF (llcompute_core) THEN
 232          IF ( pgrid%id == pgrid%max_dom ) CALL cpl_oasis_enddef()
 233          CALL wrf_message('cpl_oasis_define (compute_core) : cpl_oasis_enddef done')
 234       ELSE
 235          CALL cpl_oasis_enddef()
 236          CALL wrf_message('cpl_oasis_define (io_core) : cpl_oasis_enddef done')
 237       ENDIF
 238
 239    END SUBROUTINE cpl_oasis_define
 240
 241
 242    SUBROUTINE cpl_oasis_enddef()
 243       !!-------------------------------------------------------------------
 244       !!             ***  ROUTINE cpl_oasis_enddef  ***
 245       !!
 246       !! ** Purpose :   tells to OASIS that exchanged field definition is finished
 247       !!--------------------------------------------------------------------
 248       INTEGER :: ierror         ! return error code
 249       CALL oasis_enddef(ierror)
 250       IF( ierror /= OASIS_Ok )   CALL cpl_oasis_abort( 'cpl_oasis_define', 'Failure in oasis_enddef')
 251
 252    END SUBROUTINE cpl_oasis_enddef
 253
 254
 255    FUNCTION cpl_oasis_toreceive( kdomwrf, kdomext, kfldid )
 256       !!-------------------------------------------------------------------
 257       !!             ***  FUNCTION cpl_oasis_toreceive  ***
 258       !!
 259       !! ** Purpose :   send back a logical to tell if a variable is received or not
 260       !!--------------------------------------------------------------------
 261       INTEGER, INTENT(IN) :: kdomwrf   ! wrf domain index
 262       INTEGER, INTENT(IN) :: kdomext   ! external model domain index
 263       INTEGER, INTENT(IN) :: kfldid    ! field index
 264       !
 265       LOGICAL :: cpl_oasis_toreceive
 266       !!--------------------------------------------------------------------
 267
 268       cpl_oasis_toreceive = srcv(kdomwrf,kdomext,kfldid)%nid /= -1
 269
 270    END FUNCTION cpl_oasis_toreceive
 271
 272
 273    FUNCTION cpl_oasis_tosend( kdomwrf, kdomext, kfldid )
 274       !!-------------------------------------------------------------------
 275       !!             ***  FUNCTION cpl_oasis_tosend  ***
 276       !!
 277       !! ** Purpose :   send back a logical to tell if a variable is tosend or not
 278       !!--------------------------------------------------------------------
 279       INTEGER, INTENT(IN) :: kdomwrf   ! wrf domain index
 280       INTEGER, INTENT(IN) :: kdomext   ! external model domain index
 281       INTEGER, INTENT(IN) :: kfldid    ! field index
 282       !
 283       LOGICAL :: cpl_oasis_tosend
 284       !!--------------------------------------------------------------------
 285
 286       cpl_oasis_tosend = ssnd(kdomwrf,kdomext,kfldid)%nid /= -1
 287
 288    END FUNCTION cpl_oasis_tosend
 289
 290
 291    SUBROUTINE cpl_oasis_snd( kdomwrf, kdomext, kfldid, ksec, pdata )
 292       !!---------------------------------------------------------------------
 293       !!              ***  ROUTINE cpl_oasis_snd  ***
 294       !!
 295       !! ** Purpose : - At each coupling time-step,this routine sends fields to the coupler
 296       !!----------------------------------------------------------------------
 297       INTEGER,              INTENT(IN) :: kdomwrf   ! wrf domain index
 298       INTEGER,              INTENT(IN) :: kdomext   ! external model domain index
 299       INTEGER,              INTENT(IN) :: kfldid    ! field index
 300       INTEGER,              INTENT(IN) :: ksec      ! time-step in seconds
 301       REAL, DIMENSION(:,:), INTENT(IN) :: pdata     ! data to be sent
 302       !!
 303       INTEGER :: info              ! OASIS3 info argument
 304       LOGICAL :: llaction          ! true if we sent data to the coupler
 305       !!--------------------------------------------------------------------
 306       !
 307       WRITE(cltxt,*) 'OASIS_PUT in: kdomwrf, kdomext, kfldid, name, ksec', &
 308          kdomwrf, kdomext, kfldid, ' ', TRIM(ssnd(kdomwrf,kdomext,kfldid)%clname), ksec
 309       CALL wrf_debug(nlevdbg, cltxt)
 310
 311 #if ( RWORDSIZE == 8 )
 312       CALL oasis_put(ssnd(kdomwrf,kdomext,kfldid)%nid, ksec,      pdata(:,:) , info)
 313 #else
 314       CALL oasis_put(ssnd(kdomwrf,kdomext,kfldid)%nid, ksec, DBLE(pdata(:,:)), info)
 315 #endif
 316
 317       WRITE(cltxt,*) 'OASIS_PUT out: info', info   ;   CALL wrf_debug(nlevdbg, cltxt)
 318
 319       llaction = info == OASIS_Sent     .OR. info == OASIS_ToRest .OR.   &
 320          &       info == OASIS_SentOut  .OR. info == OASIS_ToRestOut
 321
 322       WRITE(cltxt,*) "llaction : ", llaction       ;   CALL wrf_debug(nlevdbg, cltxt)
 323
 324       IF( llaction ) THEN
 325          WRITE(cltxt,*) '****************'                                                  ;   CALL wrf_debug(nlevdbg, cltxt)
 326          WRITE(cltxt,*) 'oasis_put: Incoming ', TRIM(ssnd(kdomwrf,kdomext,kfldid)%clname)   ;   CALL wrf_debug(nlevdbg, cltxt)
 327          WRITE(cltxt,*) 'oasis_put:    varid ', ssnd(kdomwrf,kdomext,kfldid)%nid            ;   CALL wrf_debug(nlevdbg, cltxt)
 328          WRITE(cltxt,*) 'oasis_put:     ksec ', ksec                                        ;   CALL wrf_debug(nlevdbg, cltxt)
 329          WRITE(cltxt,*) 'oasis_put:     info ', info                                        ;   CALL wrf_debug(nlevdbg, cltxt)
 330          WRITE(cltxt,*) '    - shape         ', SHAPE(pdata)                                ;   CALL wrf_debug(nlevdbg, cltxt)
 331          WRITE(cltxt,*) '    - minimum       ', MINVAL(pdata)                               ;   CALL wrf_debug(nlevdbg, cltxt)
 332          WRITE(cltxt,*) '    - maximum       ', MAXVAL(pdata)                               ;   CALL wrf_debug(nlevdbg, cltxt)
 333          WRITE(cltxt,*) '    - sum           ', SUM(pdata)                                  ;   CALL wrf_debug(nlevdbg, cltxt)
 334          WRITE(cltxt,*) '****************'                                                  ;   CALL wrf_debug(nlevdbg, cltxt)
 335       ELSE
 336          WRITE(cltxt,*) 'field not sent as info=', info                                     ;   CALL wrf_debug(nlevdbg, cltxt)
 337       ENDIF
 338
 339     END SUBROUTINE cpl_oasis_snd
 340
 341
 342    SUBROUTINE cpl_oasis_rcv( kdomwrf, kdomext, kfldid, ksec, pcplrcv )
 343
 344       !!---------------------------------------------------------------------
 345       !!              ***  ROUTINE cpl_oasis_rcv  ***
 346       !!
 347       !! ** Purpose : - At each coupling time-step, this routine check if it is the good time
 348       !!                to receive field from the coupler
 349       !!----------------------------------------------------------------------
 350       INTEGER,              INTENT(IN   ) :: kdomwrf   ! wrf domain index
 351       INTEGER,              INTENT(IN   ) :: kdomext   ! external model domain index
 352       INTEGER,              INTENT(IN   ) :: kfldid    ! variable index
 353       INTEGER,              INTENT(IN   ) :: ksec      ! number of seconds since the last restart
 354       REAL, DIMENSION(:,:), INTENT(  OUT) :: pcplrcv   ! output data
 355       !!
 356       INTEGER :: info              ! OASIS3 info argument
 357       LOGICAL :: llaction          ! true if we received data from the coupler
 358       !!--------------------------------------------------------------------
 359       !
 360       WRITE(cltxt,*) 'OASIS_GET in: kdomwrf, kdomext, kfldid, name, ksec', &
 361          kdomwrf, kdomext, kfldid, ' ', TRIM(srcv(kdomwrf,kdomext,kfldid)%clname), ksec
 362       CALL wrf_debug(nlevdbg, cltxt)
 363
 364       CALL oasis_get( srcv(kdomwrf,kdomext,kfldid)%nid, ksec, srcv(kdomwrf,kdomext,kfldid)%dbl2d, info )
 365 #if ( RWORDSIZE == 8 )
 366       pcplrcv(:,:) =      srcv(kdomwrf,kdomext,kfldid)%dbl2d
 367 #else
 368       pcplrcv(:,:) = REAL(srcv(kdomwrf,kdomext,kfldid)%dbl2d, kind=4)
 369 #endif
 370
 371       WRITE(cltxt,*) 'OASIS_GET out: info', info   ;   CALL wrf_debug(nlevdbg, cltxt)
 372
 373       llaction = info == OASIS_Recvd   .OR. info == OASIS_FromRest .OR.   &
 374          &       info == OASIS_RecvOut .OR. info == OASIS_FromRestOut
 375
 376       WRITE(cltxt,*) "llaction : ", llaction       ;   CALL wrf_debug(nlevdbg, cltxt)
 377
 378       IF( llaction ) THEN
 379             WRITE(cltxt,*) '****************'                                                   ;   CALL wrf_debug(nlevdbg, cltxt)
 380             WRITE(cltxt,*) 'oasis_get: Incoming ', TRIM(srcv(kdomwrf,kdomext,kfldid)%clname)    ;   CALL wrf_debug(nlevdbg, cltxt)
 381             WRITE(cltxt,*) 'oasis_get:    varid ', srcv(kdomwrf,kdomext,kfldid)%nid             ;   CALL wrf_debug(nlevdbg, cltxt)
 382             WRITE(cltxt,*) 'oasis_get:     ksec ', ksec                                         ;   CALL wrf_debug(nlevdbg, cltxt)
 383             WRITE(cltxt,*) 'oasis_get:     info ', info                                         ;   CALL wrf_debug(nlevdbg, cltxt)
 384             WRITE(cltxt,*) '    - shape         ', SHAPE(pcplrcv)                               ;   CALL wrf_debug(nlevdbg, cltxt)
 385             WRITE(cltxt,*) '    - local shape   ', SHAPE(srcv(kdomwrf, kdomext,kfldid)%dbl2d)   ;   CALL wrf_debug(nlevdbg, cltxt)
 386             WRITE(cltxt,*) '    - local minimum ', MINVAL(pcplrcv)                              ;   CALL wrf_debug(nlevdbg, cltxt)
 387             WRITE(cltxt,*) '    - local maximum ', MAXVAL(pcplrcv)                              ;   CALL wrf_debug(nlevdbg, cltxt)
 388             WRITE(cltxt,*) '    - local sum     ', SUM(pcplrcv)                                 ;   CALL wrf_debug(nlevdbg, cltxt)
 389             WRITE(cltxt,*) '****************'                                                   ;   CALL wrf_debug(nlevdbg, cltxt)
 390       ELSE
 391             WRITE(cltxt,*) '****************'                                                   ;   CALL wrf_debug(nlevdbg, cltxt)
 392             WRITE(cltxt,*) 'oasis_get: field not received as info = ', info                     ;   CALL wrf_debug(nlevdbg, cltxt)
 393             WRITE(cltxt,*) '    - local minimum ', MINVAL(pcplrcv)                              ;   CALL wrf_debug(nlevdbg, cltxt)
 394             WRITE(cltxt,*) '    - local maximum ', MAXVAL(pcplrcv)                              ;   CALL wrf_debug(nlevdbg, cltxt)
 395             WRITE(cltxt,*) '    - local sum     ', SUM(pcplrcv)                                 ;   CALL wrf_debug(nlevdbg, cltxt)
 396             WRITE(cltxt,*) '****************'                                                   ;   CALL wrf_debug(nlevdbg, cltxt)
 397       ENDIF
 398
 399    END SUBROUTINE cpl_oasis_rcv
 400
 401
 402    SUBROUTINE cpl_oasis_finalize()
 403       !!---------------------------------------------------------------------
 404       !!              ***  ROUTINE cpl_oasis_finalize  ***
 405       !!
 406       !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
 407       !!      called explicitly before cpl_oasis_init it will also close
 408       !!      MPI communication.
 409       !!----------------------------------------------------------------------
 410       INTEGER :: ierror         ! return error code
 411       INTEGER :: jw,je,jf       ! local loop indicees
 412       !!--------------------------------------------------------------------
 413       DO jf = 1, max_cplfld
 414          DO je = 1, max_extdomains
 415             DO jw = 1, max_domains
 416                ierror = 0
 417                IF ( ASSOCIATED(srcv(jw,je,jf)%dbl2d) ) DEALLOCATE( srcv(jw,je,jf)%dbl2d, stat = ierror )
 418                IF (ierror > 0) THEN
 419                   CALL cpl_oasis_abort( 'cpl_oasis_finalize', 'Failure in deallocating ')
 420                   RETURN
 421                ENDIF
 422             END DO
 423          END DO
 424       END DO
 425       CALL oasis_terminate ( ierror )
 426
 427    END SUBROUTINE cpl_oasis_finalize
 428
 429
 430    SUBROUTINE cpl_oasis_abort( cdroutine, cdtxt )
 431       !!---------------------------------------------------------------------
 432       !!              ***  ROUTINE cpl_oasis_abort  ***
 433       !!
 434       !! ** Purpose :   abort coupling simulation
 435       !!----------------------------------------------------------------------
 436       CHARACTER(*), INTENT(IN) :: cdroutine   ! name of the subroutine calling cpl_oasis_abort
 437       CHARACTER(*), INTENT(IN) :: cdtxt       ! aborting text
 438       !!--------------------------------------------------------------------
 439
 440       CALL wrf_message( '     ==== ABORTING ====' )
 441       CALL wrf_message( 'cpl_abort called by '//TRIM(cdroutine) )
 442       CALL wrf_message( '   ==> '//TRIM(cdtxt) )
 443       CALL oasis_abort( ncomp_id, cdroutine, cdtxt )
 444
 445    END SUBROUTINE cpl_oasis_abort
 446
 447 #else
 448    !!----------------------------------------------------------------------
 449    !!   Dummy modules just for compilation...
 450    !!----------------------------------------------------------------------
 451    USE module_domain, ONLY : domain
 452    IMPLICIT NONE
 453    PRIVATE
 454    PUBLIC cpl_oasis_init
 455    PUBLIC cpl_oasis_def_dmcomm
 456    PUBLIC cpl_oasis_define
 457    PUBLIC cpl_oasis_toreceive
 458    PUBLIC cpl_oasis_tosend
 459    PUBLIC cpl_oasis_snd
 460    PUBLIC cpl_oasis_rcv
 461    PUBLIC cpl_oasis_finalize
 462    PUBLIC cpl_oasis_abort
 463
 464 CONTAINS
 465
 466    SUBROUTINE cpl_oasis_init( kl_comm )
 467       INTEGER, INTENT(OUT) :: kl_comm       ! local communicator of the model
 468       IF (.FALSE.) kl_comm = -1 ! to avoid compilation warning
 469    END SUBROUTINE cpl_oasis_init
 470
 471    SUBROUTINE cpl_oasis_def_dmcomm( kdm_comm )
 472       INTEGER, INTENT(IN) :: kdm_comm       ! computing nodes communicator
 473       IF (.FALSE.) WRITE(*,*) kdm_comm ! to avoid compilation warning
 474    END SUBROUTINE cpl_oasis_def_dmcomm
 475
 476    SUBROUTINE cpl_oasis_define( cdsndname, cdrcvname, pgrid )
 477       CHARACTER(*), INTENT(IN), DIMENSION(:,:,:)  :: cdsndname, cdrcvname   ! coupling field names
 478       TYPE(domain), INTENT(IN), OPTIONAL, POINTER :: pgrid                  ! grid structure
 479       IF (.FALSE.) WRITE(*,*) cdsndname, cdrcvname, pgrid%id  ! to avoid compilation warning
 480    END SUBROUTINE cpl_oasis_define
 481
 482    FUNCTION cpl_oasis_toreceive( kdomwrf, kdomext, kfldid )
 483       INTEGER, INTENT(IN) :: kdomwrf   ! wrf domain index
 484       INTEGER, INTENT(IN) :: kdomext   ! external model domain index
 485       INTEGER, INTENT(IN) :: kfldid    ! field index
 486       LOGICAL :: cpl_oasis_toreceive
 487       IF (.FALSE.) WRITE(*,*) kdomwrf, kdomext, kfldid  ! to avoid compilation warning
 488       IF (.FALSE.) cpl_oasis_toreceive = .false.  ! to avoid compilation warning
 489    END FUNCTION cpl_oasis_toreceive
 490
 491    FUNCTION cpl_oasis_tosend( kdomwrf, kdomext, kfldid )
 492       INTEGER, INTENT(IN) :: kdomwrf   ! wrf domain index
 493       INTEGER, INTENT(IN) :: kdomext   ! external model domain index
 494       INTEGER, INTENT(IN) :: kfldid    ! field index
 495       LOGICAL :: cpl_oasis_tosend
 496       IF (.FALSE.) WRITE(*,*) kdomwrf, kdomext, kfldid  ! to avoid compilation warning
 497       IF (.FALSE.) cpl_oasis_tosend = .false.  ! to avoid compilation warning
 498    END FUNCTION cpl_oasis_tosend
 499
 500    SUBROUTINE cpl_oasis_snd( kdomwrf, kdomext, kfldid, ksec, pdata )
 501       !!----------------------------------------------------------------------
 502       INTEGER,              INTENT(IN) :: kdomwrf   ! wrf domain index
 503       INTEGER,              INTENT(IN) :: kdomext   ! external model domain index
 504       INTEGER,              INTENT(IN) :: kfldid    ! field index
 505       INTEGER,              INTENT(IN) :: ksec      ! time-step in seconds
 506       REAL, DIMENSION(:,:), INTENT(IN) :: pdata     ! data to be sent
 507       IF (.FALSE.) WRITE(*,*) kdomwrf, kdomext, kfldid, ksec, pdata ! to avoid compilation warning
 508    END SUBROUTINE cpl_oasis_snd
 509
 510    SUBROUTINE cpl_oasis_rcv( kdomwrf, kdomext, kfldid, ksec, pcplrcv )
 511       INTEGER,              INTENT(IN   ) :: kdomwrf   ! wrf domain index
 512       INTEGER,              INTENT(IN   ) :: kdomext   ! external model domain index
 513       INTEGER,              INTENT(IN   ) :: kfldid    ! variable index
 514       INTEGER,              INTENT(IN   ) :: ksec      ! number of seconds since the last restart
 515       REAL, DIMENSION(:,:), INTENT(  OUT) :: pcplrcv   ! output data
 516       IF (.FALSE.) WRITE(*,*) kdomwrf, kdomext, kfldid, ksec ! to avoid compilation warning
 517       IF (.FALSE.) pcplrcv(:,:) = -1. ! to avoid compilation warning
 518    END SUBROUTINE cpl_oasis_rcv
 519
 520    SUBROUTINE cpl_oasis_finalize()
 521       IF (.FALSE.) WRITE(*,*) 'You should not be there...'
 522    END SUBROUTINE cpl_oasis_finalize
 523
 524    SUBROUTINE cpl_oasis_abort( cdroutine, cdtxt )
 525       CHARACTER(*), INTENT(IN) :: cdroutine   ! name of the subroutine calling cpl_oasis_abort
 526       CHARACTER(*), INTENT(IN) :: cdtxt       ! aborting text
 527       IF (.FALSE.) WRITE(*,*) cdroutine, cdtxt   ! to avoid compilation warning
 528    END SUBROUTINE cpl_oasis_abort
 529 #endif
 530
 531 END MODULE module_cpl_oasis3