- Timestamp:
- 2018-11-01T11:35:45+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r10159 r10269 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 … … 34 35 IMPLICIT NONE 35 36 PRIVATE 37 38 #if ! defined key_oasis3 39 ! Dummy interface to oasis_get if not using oasis 40 INTERFACE oasis_get 41 MODULE PROCEDURE oasis_get_1d, oasis_get_2d 42 END INTERFACE 43 #endif 36 44 37 45 PUBLIC cpl_init … … 39 47 PUBLIC cpl_snd 40 48 PUBLIC cpl_rcv 49 PUBLIC cpl_rcv_1d 41 50 PUBLIC cpl_freq 42 51 PUBLIC cpl_finalize … … 88 97 INTEGER :: nct ! Number of categories in field 89 98 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 99 INTEGER :: dimensions ! Number of dimensions of coupling field 90 100 END TYPE FLD_CPL 91 101 … … 150 160 ! 151 161 INTEGER :: id_part 162 INTEGER :: id_part_0d ! Partition for 0d fields 163 INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 164 INTEGER :: id_part_temp ! Temperary partition used to choose either 0d or 1d partitions 152 165 INTEGER :: paral(5) ! OASIS3 box partition 153 INTEGER :: ishape(4) ! Shape of arrays passed to PSMILe.166 INTEGER :: ishape(4) ! Shape of 2D arrays passed to PSMILe. 154 167 ! Redundant from OASIS3-MCT vn4.0 onwards but required 155 ! to satisfy interface and for backward compatibility. 168 ! to satisfy interface and for backward compatibility. 169 INTEGER :: ishape0d1d(2) ! Shape of 0D or 1D arrays passed to PSMILe. 156 170 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 157 171 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards … … 195 209 ishape(4) = nlej-nldj+1 196 210 211 ishape0d1d(1) = 0 212 ishape0d1d(2) = 0 197 213 198 214 ! … … 222 238 223 239 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 240 241 ! A special partition is needed for 0D fields 242 243 paral(1) = 0 ! serial partitioning 244 paral(2) = 0 245 IF ( nproc == 0) THEN 246 paral(3) = 1 ! Size of array to couple (scalar) 247 ELSE 248 paral(3) = 0 ! Dummy size for PE's not involved 249 END IF 250 paral(4) = 0 251 paral(5) = 0 252 253 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 254 255 ! Another partition is needed for 1D river routing fields 256 257 paral(1) = 0 ! serial partitioning 258 paral(2) = 0 259 IF ( nproc == 0) THEN 260 paral(3) = nn_cpl_river ! Size of array to couple (vector) 261 ELSE 262 paral(3) = 0 ! Dummy size for PE's not involved 263 END IF 264 paral(4) = 0 265 paral(5) = 0 266 267 268 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 269 224 270 ! 225 271 ! ... Announce send variables. … … 306 352 #endif 307 353 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 ) 354 flush(numout) 355 356 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 357 IF (srcv(ji)%dimensions <= 1) THEN 358 var_nodims(1) = 1 359 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 360 IF (nproc == 0) THEN 361 362 IF (srcv(ji)%dimensions == 0) THEN 363 364 ! If 0D then set temporary variables to 0D components 365 id_part_temp = id_part_0d 366 ishape0d1d(2) = 1 367 ELSE 368 369 ! If 1D then set temporary variables to river outflow components 370 id_part_temp = id_part_rnf_1d 371 ishape0d1d(2)= nn_cpl_river 372 373 END IF 374 375 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , var_nodims, & 376 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 377 ELSE 378 ! Dummy call to keep OASIS3-MCT happy. 379 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , var_nodims, & 380 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 381 END IF 382 ELSE 383 ! It's a "normal" 2D (or pseudo 3D) coupling field. 384 ! ... Set the field dimension and bundle count 385 var_nodims(1) = 2 386 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 387 388 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 389 OASIS_In , ishape , OASIS_REAL, nerror ) 390 ENDIF 391 315 392 IF ( nerror /= OASIS_Ok ) THEN 316 393 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 412 489 413 490 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 414 491 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 415 492 416 493 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) … … 437 514 WRITE(numout,*) '****************' 438 515 ENDIF 439 516 440 517 ENDIF 441 518 442 519 ENDIF 443 520 … … 451 528 ! 452 529 END SUBROUTINE cpl_rcv 530 531 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 532 !!--------------------------------------------------------------------- 533 !! *** ROUTINE cpl_rcv_1d *** 534 !! 535 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 536 !! receipt of 0D or 1D fields. 537 !! The fields are recieved into a 1D array buffer which is simply a 538 !! dynamically sized sized array (which may be of size 1) 539 !! of 0 dimensional fields. This allows us to pass miltiple 0D 540 !! fields via a single put/get operation. 541 !!---------------------------------------------------------------------- 542 INTEGER , INTENT(in ) :: nitems ! Number of 0D items to recieve 543 ! during this get operation. i.e. 544 ! The size of the 1D array in which 545 ! 0D items are passed. 546 INTEGER , INTENT(in ) :: kid ! ID index of the incoming 547 ! data. 548 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 549 REAL(wp), INTENT(inout) :: pdata(1:nitems) ! The original value(s), 550 ! unchanged if nothing is 551 ! received 552 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 553 !! 554 REAL(wp) :: recvfld(1:nitems) ! Local receive field buffer 555 INTEGER :: jc,jm ! local loop index 556 INTEGER :: ierr 557 LOGICAL :: llaction 558 INTEGER :: MPI_WORKING_PRECISION 559 INTEGER :: number_to_print 560 !!-------------------------------------------------------------------- 561 ! 562 ! receive local data from OASIS3 on every process 563 ! 564 kinfo = OASIS_idle 565 ! 566 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 567 ! so we only cater for a single set of values and thus don't bother 568 ! with a loop over the jc index 569 jc = 1 570 571 DO jm = 1, srcv(kid)%ncplmodel 572 573 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 574 575 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 576 ! Since there is no concept of data decomposition for zero 577 ! dimension fields, they must only be exchanged through the master PE, 578 ! unlike "normal" 2D field cases where every PE is involved. 579 580 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 581 582 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 583 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 584 585 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 586 llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 587 588 IF ( llaction ) THEN 589 590 kinfo = OASIS_Rcv 591 pdata(1:nitems) = recvfld(1:nitems) 592 593 IF ( ln_ctl ) THEN 594 number_to_print = 10 595 IF ( nitems < number_to_print ) number_to_print = nitems 596 WRITE(numout,*) '****************' 597 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 598 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 599 WRITE(numout,*) 'oasis_get: kstep', kstep 600 WRITE(numout,*) 'oasis_get: info ', kinfo 601 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 602 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 603 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 604 WRITE(numout,*) '****************' 605 ENDIF 606 607 ENDIF 608 ENDIF 609 ENDIF 610 611 ENDDO 612 613 ! Set the precision that we want to broadcast using MPI_BCAST 614 SELECT CASE( wp ) 615 CASE( sp ) 616 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 617 CASE( dp ) 618 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 619 CASE default 620 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 621 END SELECT 622 623 ! We have to broadcast (potentially) received values from PE 0 to all 624 ! the others. If no new data has been received we're just 625 ! broadcasting the existing values but there's no more efficient way 626 ! to deal with that w/o NEMO adopting a UM-style test mechanism 627 ! to determine active put/get timesteps. 628 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 629 630 ! 631 END SUBROUTINE cpl_rcv_1d 453 632 454 633 … … 564 743 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 565 744 CHARACTER(*), INTENT(in ) :: cd1 566 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5( 2,2),k6745 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(*),k6 567 746 INTEGER , INTENT( out) :: k1,k7 568 747 k1 = -1 ; k7 = -1 … … 584 763 END SUBROUTINE oasis_put 585 764 586 SUBROUTINE oasis_get(k1,k2,p1,k3) 765 SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 766 REAL(wp), DIMENSION(:) , INTENT( out) :: p1 767 INTEGER , INTENT(in ) :: k1,k2 768 INTEGER , INTENT( out) :: k3 769 p1(1) = -1. ; k3 = -1 770 WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 771 END SUBROUTINE oasis_get_1d 772 773 SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 587 774 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 588 775 INTEGER , INTENT(in ) :: k1,k2 589 776 INTEGER , INTENT( out) :: k3 590 777 p1(1,1) = -1. ; k3 = -1 591 WRITE(numout,*) 'oasis_get : Error you sould not be there...'592 END SUBROUTINE oasis_get 778 WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 779 END SUBROUTINE oasis_get_2d 593 780 594 781 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
Note: See TracChangeset
for help on using the changeset viewer.
