Changeset 10176 for branches/UKMO/dev_r5518_GO6_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
- Timestamp:
- 2018-10-05T17:57:31+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r10159 r10176 28 28 #endif 29 29 USE par_oce ! ocean parameters 30 USE cpl_rnf_1d, ONLY: nn_cpl_river ! Variables used in 1D river outflow 30 31 USE dom_oce ! ocean space and time domain 31 32 USE in_out_manager ! I/O manager … … 39 40 PUBLIC cpl_snd 40 41 PUBLIC cpl_rcv 42 PUBLIC cpl_rcv_1d 41 43 PUBLIC cpl_freq 42 44 PUBLIC cpl_finalize … … 88 90 INTEGER :: nct ! Number of categories in field 89 91 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 92 INTEGER :: dimensions ! Number of dimensions of coupling field 90 93 END TYPE FLD_CPL 91 94 … … 150 153 ! 151 154 INTEGER :: id_part 155 INTEGER :: id_part_0d ! Partition for 0d fields 156 INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 157 INTEGER :: id_part_temp ! Temperary partition used to choose either 0d or 1d partitions 158 INTEGER :: vector_length ! Length of 0d or 1d variables (0d variables will have vector_length=1) 152 159 INTEGER :: paral(5) ! OASIS3 box partition 153 160 INTEGER :: ishape(4) ! Shape of arrays passed to PSMILe. … … 222 229 223 230 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 231 232 ! A special partition is needed for 0D fields 233 234 paral(1) = 0 ! serial partitioning 235 paral(2) = 0 236 IF ( nproc == 0) THEN 237 paral(3) = 1 ! Size of array to couple (scalar) 238 ELSE 239 paral(3) = 0 ! Dummy size for PE's not involved 240 END IF 241 paral(4) = 0 242 paral(5) = 0 243 244 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 245 246 ! Another partition is needed for 1D river routing fields 247 248 paral(1) = 0 ! serial partitioning 249 paral(2) = 0 250 IF ( nproc == 0) THEN 251 paral(3) = nn_cpl_river ! Size of array to couple (vector) 252 ELSE 253 paral(3) = 0 ! Dummy size for PE's not involved 254 END IF 255 paral(4) = 0 256 paral(5) = 0 257 258 259 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 260 224 261 ! 225 262 ! ... Announce send variables. … … 306 343 #endif 307 344 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 308 309 ! ... Set the field dimension and bundle count 310 var_nodims(1) = 2 311 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 312 313 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 314 & OASIS_In , ishape , OASIS_REAL, nerror ) 345 flush(numout) 346 347 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 348 IF (srcv(ji)%dimensions <= 1) THEN 349 var_nodims(1) = 1 350 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 351 IF (nproc == 0) THEN 352 353 IF (srcv(ji)%dimensions == 0) THEN 354 355 ! If 0D then set temporary variables to 0D components 356 id_part_temp = id_part_0d 357 vector_length = 1 358 ELSE 359 360 ! If 1D then set temporary variables to river outflow components 361 id_part_temp = id_part_rnf_1d 362 vector_length = nn_cpl_river 363 364 END IF 365 366 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , var_nodims, & 367 OASIS_In , (/ 1, vector_length /) , OASIS_REAL, nerror ) 368 ELSE 369 ! Dummy call to keep OASIS3-MCT happy. 370 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , var_nodims, & 371 OASIS_In , (/ 0, 0 /) , OASIS_REAL, nerror ) 372 END IF 373 ELSE 374 ! It's a "normal" 2D (or pseudo 3D) coupling field. 375 ! ... Set the field dimension and bundle count 376 var_nodims(1) = 2 377 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 378 379 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 380 OASIS_In , ishape , OASIS_REAL, nerror ) 381 ENDIF 382 315 383 IF ( nerror /= OASIS_Ok ) THEN 316 384 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 412 480 413 481 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 414 482 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 415 483 416 484 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) … … 437 505 WRITE(numout,*) '****************' 438 506 ENDIF 439 507 440 508 ENDIF 441 509 442 510 ENDIF 443 511 … … 451 519 ! 452 520 END SUBROUTINE cpl_rcv 521 522 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 523 !!--------------------------------------------------------------------- 524 !! *** ROUTINE cpl_rcv_1d *** 525 !! 526 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 527 !! receipt of 0D or 1D fields. 528 !! The fields are recieved into a 1D array buffer which is simply a 529 !! dynamically sized sized array (which may be of size 1) 530 !! of 0 dimensional fields. This allows us to pass miltiple 0D 531 !! fields via a single put/get operation. 532 !!---------------------------------------------------------------------- 533 INTEGER , INTENT(in ) :: nitems ! Number of 0D items to recieve 534 ! during this get operation. i.e. 535 ! The size of the 1D array in which 536 ! 0D items are passed. 537 INTEGER , INTENT(in ) :: kid ! ID index of the incoming 538 ! data. 539 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 540 REAL(wp), INTENT(inout) :: pdata(1:nitems) ! The original value(s), 541 ! unchanged if nothing is 542 ! received 543 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 544 !! 545 REAL(wp) :: recvfld(1:nitems) ! Local receive field buffer 546 INTEGER :: jc,jm ! local loop index 547 INTEGER :: ierr 548 LOGICAL :: llaction 549 INTEGER :: MPI_WORKING_PRECISION 550 INTEGER :: number_to_print 551 !!-------------------------------------------------------------------- 552 ! 553 ! receive local data from OASIS3 on every process 554 ! 555 kinfo = OASIS_idle 556 ! 557 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 558 ! so we only cater for a single set of values and thus don't bother 559 ! with a loop over the jc index 560 jc = 1 561 562 DO jm = 1, srcv(kid)%ncplmodel 563 564 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 565 566 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 567 ! Since there is no concept of data decomposition for zero 568 ! dimension fields, they must only be exchanged through the master PE, 569 ! unlike "normal" 2D field cases where every PE is involved. 570 571 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 572 573 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 574 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 575 576 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 577 llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 578 579 IF ( llaction ) THEN 580 581 kinfo = OASIS_Rcv 582 pdata(1:nitems) = recvfld(1:nitems) 583 584 IF ( ln_ctl ) THEN 585 number_to_print = 10 586 IF ( nitems < number_to_print ) number_to_print = nitems 587 WRITE(numout,*) '****************' 588 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 589 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 590 WRITE(numout,*) 'oasis_get: kstep', kstep 591 WRITE(numout,*) 'oasis_get: info ', kinfo 592 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 593 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 594 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 595 WRITE(numout,*) '****************' 596 ENDIF 597 598 ENDIF 599 ENDIF 600 ENDIF 601 602 ENDDO 603 604 ! Set the precision that we want to broadcast using MPI_BCAST 605 SELECT CASE( wp ) 606 CASE( sp ) 607 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 608 CASE( dp ) 609 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 610 CASE default 611 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 612 END SELECT 613 614 ! We have to broadcast (potentially) received values from PE 0 to all 615 ! the others. If no new data has been received we're just 616 ! broadcasting the existing values but there's no more efficient way 617 ! to deal with that w/o NEMO adopting a UM-style test mechanism 618 ! to determine active put/get timesteps. 619 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 620 621 ! 622 END SUBROUTINE cpl_rcv_1d 453 623 454 624
Note: See TracChangeset
for help on using the changeset viewer.
