Changeset 11286 for branches/UKMO/AMM15_v3_6_STABLE_package_collate_xeps/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
- Timestamp:
- 2019-07-18T11:54:22+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_xeps/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r8058 r11286 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 … … 32 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 33 34 #if defined key_cpl_rootexchg 35 USE lib_mpp, only : mppsync 36 USE lib_mpp, only : mppscatter,mppgather 37 #endif 38 34 39 IMPLICIT NONE 35 40 PRIVATE … … 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 … … 65 81 INTEGER :: nsnd ! total number of fields sent 66 82 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 67 INTEGER, PUBLIC, PARAMETER :: nmaxfld=5 0! Maximum number of coupling fields83 INTEGER, PUBLIC, PARAMETER :: nmaxfld=55 ! Maximum number of coupling fields 68 84 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 69 85 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 82 98 83 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 84 102 85 103 !!---------------------------------------------------------------------- … … 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 … … 149 168 IF(lwp) WRITE(numout,*) 150 169 170 commRank = .false. 171 IF ( rootexchg ) THEN 172 IF ( nproc == localRoot ) commRank = .true. 173 ELSE 174 commRank = .true. 175 ENDIF 176 151 177 ncplmodel = kcplmodel 152 178 IF( kcplmodel > nmaxcpl ) THEN … … 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 ! ----------------------------------------------------------------- … … 183 203 ! ----------------------------------------------------------------- 184 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 185 214 paral(1) = 2 ! box partitioning 186 215 paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset … … 196 225 ENDIF 197 226 198 CALL oasis_def_partition ( id_part, paral, nerror ) 227 ENDIF 228 IF ( commRank ) CALL oasis_def_partition ( id_part, paral, nerror ) 229 230 ! ... Allocate memory for data exchange 231 ! 232 ALLOCATE(exfld(paral(3), paral(4)), stat = nerror) 233 IF( nerror > 0 ) THEN 234 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 235 ENDIF 236 IF ( rootexchg ) THEN 237 ! Should possibly use one of the work arrays for tbuf really 238 ALLOCATE(tbuf(jpi, jpj, jpnij), stat = nerror) 239 IF( nerror > 0 ) THEN 240 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating tbuf') ; RETURN 241 ENDIF 242 ENDIF 243 ! 244 IF (commRank ) THEN 199 245 ! 200 246 ! ... Announce send variables. … … 288 334 ENDIF 289 335 END DO 336 ! 337 ENDIF ! commRank=true 290 338 291 339 !------------------------------------------------------------------ … … 293 341 !------------------------------------------------------------------ 294 342 295 CALL oasis_enddef(nerror) 296 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 343 IF ( commRank ) THEN 344 CALL oasis_enddef(nerror) 345 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 346 ENDIF 297 347 ! 298 348 END SUBROUTINE cpl_define … … 311 361 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 312 362 !! 313 INTEGER :: j c,jm! local loop index363 INTEGER :: jn,jc,jm ! local loop index 314 364 !!-------------------------------------------------------------------- 315 365 ! … … 320 370 321 371 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 ) 372 IF ( rootexchg ) THEN 373 ! 374 ! collect data on the local root process 375 ! 376 CALL mppgather (pdata(:,:,jc),localRoot,tbuf) 377 CALL mppsync 378 379 IF ( nproc == localRoot ) THEN 380 DO jn = 1, jpnij 381 exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1)= & 382 tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn) 383 ENDDO 384 ! snd data to OASIS3 385 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, exfld, kinfo ) 386 ENDIF 387 ELSE 388 ! snd data to OASIS3 389 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 390 ENDIF 323 391 324 392 IF ( ln_ctl ) THEN … … 358 426 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 359 427 !! 360 INTEGER :: j c,jm! local loop index428 INTEGER :: jn,jc,jm ! local loop index 361 429 LOGICAL :: llaction, llfisrt 362 430 !!-------------------------------------------------------------------- … … 372 440 373 441 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 374 375 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 442 ! 443 ! receive data from OASIS3 444 ! 445 IF ( commRank ) CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 446 IF ( rootexchg ) CALL MPI_BCAST ( kinfo, 1, MPI_INTEGER, localRoot, localComm, nerror ) 376 447 377 448 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & … … 384 455 kinfo = OASIS_Rcv 385 456 IF( llfisrt ) THEN 386 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 457 IF ( rootexchg ) THEN 458 ! distribute data to processes 459 ! 460 IF ( nproc == localRoot ) THEN 461 DO jn = 1, jpnij 462 tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn)= & 463 exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1) 464 ! NOTE: we are missing combining this with pmask (see else below) 465 ENDDO 466 ENDIF 467 CALL mppscatter(tbuf,localRoot,pdata(:,:,jc)) 468 CALL mppsync 469 ELSE 470 pdata(nldi:nlei, nldj:nlej, jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 471 ENDIF 387 472 llfisrt = .FALSE. 388 473 ELSE … … 462 547 #if defined key_oa3mct_v3 463 548 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 #else 549 #endif 550 #if defined key_oasis3 465 551 CALL oasis_get_freqs(id, 1, itmp, info) 466 552 #endif 467 553 cpl_freq = itmp(1) 554 #if defined key_oasis3mct 555 cpl_freq = namflddti( id ) 556 #endif 468 557 ENDIF 469 558 ! … … 481 570 ! 482 571 DEALLOCATE( exfld ) 572 IF ( rootexchg ) DEALLOCATE ( tbuf ) 483 573 IF (nstop == 0) THEN 484 574 CALL oasis_terminate( nerror ) … … 489 579 END SUBROUTINE cpl_finalize 490 580 491 #if ! defined key_oasis3 581 #if ! defined key_oasis3 && ! defined key_oasis3mct 492 582 493 583 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
