- Timestamp:
- 2015-05-20T18:20:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r5279 r5284 23 23 !! cpl_finalize : finalize the coupled mode communication 24 24 !!---------------------------------------------------------------------- 25 #if defined key_oasis3 25 #if defined key_oasis3 || defined key_oasis3mct 26 26 USE mod_oasis ! OASIS3-MCT module 27 27 #endif … … 30 30 USE in_out_manager ! I/O manager 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 33 #if defined key_cpl_rootexchg 34 USE lib_mpp, only : mppsync 35 USE lib_mpp, only : mppscatter,mppgather 36 #endif 32 37 33 38 IMPLICIT NONE … … 40 45 PUBLIC cpl_freq 41 46 PUBLIC cpl_finalize 47 #if defined key_mpp_mpi 48 INCLUDE 'mpif.h' 49 #endif 50 51 INTEGER, PARAMETER :: localRoot = 0 52 LOGICAL :: commRank ! true for ranks doing OASIS communication 53 #if defined key_cpl_rootexchg 54 LOGICAL :: rootexchg =.true. ! logical switch 55 #else 56 LOGICAL :: rootexchg =.false. ! logical switch 57 #endif 42 58 43 59 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 78 94 79 95 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 80 96 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tbuf ! Temporary buffer for sending / receiving 97 INTEGER, PUBLIC :: localComm 98 81 99 !!---------------------------------------------------------------------- 82 100 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 104 122 ! 1st Initialize the OASIS system for the application 105 123 !------------------------------------------------------------------ 106 CALL oasis_init_comp ( ncomp_id, ' oceanx', nerror )124 CALL oasis_init_comp ( ncomp_id, 'toyoce', nerror ) 107 125 IF ( nerror /= OASIS_Ok ) & 108 126 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') … … 115 133 IF ( nerror /= OASIS_Ok ) & 116 134 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 135 localComm = kl_comm 117 136 ! 118 137 END SUBROUTINE cpl_init … … 143 162 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 144 163 IF(lwp) WRITE(numout,*) 164 165 commRank = .false. 166 IF ( rootexchg ) THEN 167 IF ( nproc == localRoot ) commRank = .true. 168 ELSE 169 commRank = .true. 170 ENDIF 145 171 146 172 IF( kcplmodel > nmaxcpl ) THEN … … 155 181 ishape(:,2) = (/ 1, nlej-nldj+1 /) 156 182 ! 157 ! ... Allocate memory for data exchange158 !159 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)160 IF( nerror > 0 ) THEN161 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN162 ENDIF163 183 ! 164 184 ! ----------------------------------------------------------------- 165 185 ! ... Define the partition 166 186 ! ----------------------------------------------------------------- 187 188 IF ( rootexchg ) THEN 189 190 paral(1) = 2 ! box partitioning 191 paral(2) = 0 ! NEMO lower left corner global offset 192 paral(3) = jpiglo ! local extent in i 193 paral(4) = jpjglo ! local extent in j 194 paral(5) = jpiglo ! global extent in x 195 196 ELSE 167 197 168 198 paral(1) = 2 ! box partitioning … … 179 209 ENDIF 180 210 181 CALL oasis_def_partition ( id_part, paral, nerror ) 211 ENDIF 212 IF ( commRank ) CALL oasis_def_partition ( id_part, paral, nerror ) 213 214 ! ... Allocate memory for data exchange 215 ! 216 ALLOCATE(exfld(paral(3), paral(4)), stat = nerror) 217 IF( nerror > 0 ) THEN 218 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 219 ENDIF 220 IF ( rootexchg ) THEN 221 ! Should possibly use one of the work arrays for tbuf really 222 ALLOCATE(tbuf(jpi, jpj, jpnij), stat = nerror) 223 IF( nerror > 0 ) THEN 224 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating tbuf') ; RETURN 225 ENDIF 226 ENDIF 227 ! 228 IF (commRank ) THEN 182 229 ! 183 230 ! ... Announce send variables. … … 224 271 END DO 225 272 ENDIF 226 END DO 273 END DO 227 274 ! 228 275 ! ... Announce received variables. … … 271 318 ENDIF 272 319 END DO 320 ! 321 ENDIF ! commRank=true 273 322 274 323 !------------------------------------------------------------------ … … 276 325 !------------------------------------------------------------------ 277 326 278 CALL oasis_enddef(nerror) 279 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 327 IF ( commRank ) THEN 328 329 CALL oasis_enddef(nerror) 330 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 331 ENDIF 280 332 ! 281 333 END SUBROUTINE cpl_define … … 294 346 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 295 347 !! 296 INTEGER :: j c,jm ! local loop index348 INTEGER :: jn,jc,jm ! local loop index 297 349 !!-------------------------------------------------------------------- 298 350 ! … … 303 355 304 356 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 305 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 357 IF ( rootexchg ) THEN 358 ! 359 ! collect data on the local root process 360 ! 361 CALL mppgather (pdata(:,:,jc),localRoot,tbuf) 362 CALL mppsync 363 364 IF ( nproc == localRoot ) THEN 365 366 DO jn = 1, jpnij 367 exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1)= & 368 tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn) 369 ENDDO 370 371 ! snd data to OASIS3 372 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, exfld, kinfo ) 373 374 ENDIF 375 376 ELSE 377 378 ! snd data to OASIS3 379 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 380 ENDIF 306 381 307 382 IF ( ln_ctl ) THEN … … 341 416 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 342 417 !! 343 INTEGER :: j c,jm ! local loop index418 INTEGER :: jn,jc,jm ! local loop index 344 419 LOGICAL :: llaction, llfisrt 345 420 !!-------------------------------------------------------------------- … … 355 430 356 431 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 357 358 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 432 433 ! 434 ! receive data from OASIS3 435 ! 436 IF ( commRank ) CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 437 438 IF ( rootexchg ) CALL MPI_BCAST ( kinfo, 1, MPI_INTEGER, localRoot, localComm, nerror ) 359 439 360 440 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & … … 367 447 kinfo = OASIS_Rcv 368 448 IF( llfisrt ) THEN 369 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 449 450 IF ( rootexchg ) THEN 451 452 ! distribute data to processes 453 ! 454 IF ( nproc == localRoot ) THEN 455 456 DO jn = 1, jpnij 457 tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn)= & 458 exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1) 459 ! NOTE: we are missing combining this with pmask (see else below) 460 ENDDO 461 462 ENDIF 463 464 CALL mppscatter (tbuf,localRoot,pdata(:,:,jc)) 465 CALL mppsync 466 467 ELSE 468 469 pdata(nldi:nlei, nldj:nlej, jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 470 471 ENDIF 472 370 473 llfisrt = .FALSE. 371 474 ELSE … … 411 514 INTEGER, DIMENSION(1) :: itmp 412 515 !!---------------------------------------------------------------------- 516 #if defined key_oasis3 413 517 CALL oasis_get_freqs(kid, 1, itmp, info) 414 518 cpl_freq = itmp(1) 519 #endif 520 521 #if defined key_oasis3mct 522 cpl_freq = namflddti( kid ) 523 #endif 415 524 ! 416 525 END FUNCTION cpl_freq … … 427 536 ! 428 537 DEALLOCATE( exfld ) 538 IF ( rootexchg ) DEALLOCATE ( tbuf ) 429 539 IF (nstop == 0) THEN 430 540 CALL oasis_terminate( nerror )
Note: See TracChangeset
for help on using the changeset viewer.
