- Timestamp:
- 2016-05-18T14:16:20+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r6557 r6558 24 24 !! cpl_finalize : finalize the coupled mode communication 25 25 !!---------------------------------------------------------------------- 26 #if defined key_oasis3 26 #if defined key_oasis3 || defined key_oasis3mct 27 27 USE mod_oasis ! OASIS3-MCT module 28 28 #endif … … 31 31 USE in_out_manager ! I/O manager 32 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 33 38 34 39 IMPLICIT NONE … … 41 46 PUBLIC cpl_freq 42 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 43 59 44 60 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 46 62 INTEGER :: ncomp_id ! id returned by oasis_init_comp 47 63 INTEGER :: nerror ! return error code 48 #if ! defined key_oasis3 64 #if ! defined key_oasis3 && ! defined key_oasis3mct 49 65 ! OASIS Variables not used. defined only for compilation purpose 50 66 INTEGER :: OASIS_Out = -1 … … 82 98 83 99 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 84 100 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tbuf ! Temporary buffer for sending / receiving 101 INTEGER, PUBLIC :: localComm 102 85 103 !!---------------------------------------------------------------------- 86 104 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 120 138 IF ( nerror /= OASIS_Ok ) & 121 139 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 140 localComm = kl_comm 122 141 ! 123 142 END SUBROUTINE cpl_init … … 148 167 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 149 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 150 176 151 177 ncplmodel = kcplmodel … … 172 198 ishape(:,2) = (/ 1, nlej-nldj+1 /) 173 199 ! 174 ! ... Allocate memory for data exchange175 !176 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)177 IF( nerror > 0 ) THEN178 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN179 ENDIF180 200 ! 181 201 ! ----------------------------------------------------------------- 182 202 ! ... Define the partition 183 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 184 214 185 215 paral(1) = 2 ! box partitioning … … 196 226 ENDIF 197 227 198 CALL oasis_def_partition ( id_part, paral, nerror ) 228 ENDIF 229 IF ( commRank ) CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo ) 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 199 246 ! 200 247 ! ... Announce send variables. … … 241 288 END DO 242 289 ENDIF 243 END DO 290 END DO 244 291 ! 245 292 ! ... Announce received variables. … … 288 335 ENDIF 289 336 END DO 337 ! 338 ENDIF ! commRank=true 290 339 291 340 !------------------------------------------------------------------ … … 293 342 !------------------------------------------------------------------ 294 343 295 CALL oasis_enddef(nerror) 296 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 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 297 349 ! 298 350 END SUBROUTINE cpl_define … … 311 363 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 312 364 !! 313 INTEGER :: j c,jm ! local loop index365 INTEGER :: jn,jc,jm ! local loop index 314 366 !!-------------------------------------------------------------------- 315 367 ! … … 320 372 321 373 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 322 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 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 323 398 324 399 IF ( ln_ctl ) THEN … … 358 433 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 359 434 !! 360 INTEGER :: j c,jm ! local loop index435 INTEGER :: jn,jc,jm ! local loop index 361 436 LOGICAL :: llaction, llfisrt 362 437 !!-------------------------------------------------------------------- … … 372 447 373 448 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 374 375 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 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 ) 376 456 377 457 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & … … 384 464 kinfo = OASIS_Rcv 385 465 IF( llfisrt ) THEN 386 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 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 387 490 llfisrt = .FALSE. 388 491 ELSE … … 462 565 #if defined key_oa3mct_v3 463 566 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 #else 567 #endif 568 #if defined key_oasis3 465 569 CALL oasis_get_freqs(id, 1, itmp, info) 466 570 #endif 467 571 cpl_freq = itmp(1) 572 #if defined key_oasis3mct 573 cpl_freq = namflddti( id ) 574 #endif 468 575 ENDIF 469 576 ! … … 481 588 ! 482 589 DEALLOCATE( exfld ) 590 IF ( rootexchg ) DEALLOCATE ( tbuf ) 483 591 IF (nstop == 0) THEN 484 592 CALL oasis_terminate( nerror ) … … 489 597 END SUBROUTINE cpl_finalize 490 598 491 #if ! defined key_oasis3 599 #if ! defined key_oasis3 && ! defined key_oasis3mct 492 600 493 601 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
