Changeset 13778 for NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90
- Timestamp:
- 2020-11-11T14:27:17+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90
r13587 r13778 29 29 #endif 30 30 USE par_oce ! ocean parameters 31 USE cpl_rnf_1d, ONLY: nn_cpl_river ! Variables used in 1D river outflow 31 32 USE dom_oce ! ocean space and time domain 32 33 USE in_out_manager ! I/O manager 33 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 USE lib_mpp 34 36 35 37 IMPLICIT NONE 36 38 PRIVATE 39 40 #if ! defined key_oasis3 41 ! Dummy interface to oasis_get if not using oasis 42 INTERFACE oasis_get 43 MODULE PROCEDURE oasis_get_1d, oasis_get_2d 44 END INTERFACE 45 #endif 37 46 38 47 PUBLIC cpl_init … … 40 49 PUBLIC cpl_snd 41 50 PUBLIC cpl_rcv 51 PUBLIC cpl_rcv_1d 42 52 PUBLIC cpl_freq 43 53 PUBLIC cpl_finalize 44 54 55 #if defined key_mpp_mpi 56 INCLUDE 'mpif.h' 57 #endif 58 59 INTEGER, PARAMETER :: localRoot = 0 45 60 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 46 61 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis … … 66 81 INTEGER :: nsnd ! total number of fields sent 67 82 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=6 0! Maximum number of coupling fields83 INTEGER, PUBLIC, PARAMETER :: nmaxfld=61 ! Maximum number of coupling fields 69 84 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 85 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 81 96 INTEGER :: nct ! Number of categories in field 82 97 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 98 INTEGER :: dimensions ! Number of dimensions of coupling field 83 99 END TYPE FLD_CPL 84 100 … … 105 121 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file 106 122 INTEGER , INTENT( out) :: kl_comm ! local communicator of the model 123 INTEGER :: error 107 124 !!-------------------------------------------------------------------- 108 125 … … 141 158 ! 142 159 INTEGER :: id_part 160 INTEGER :: id_part_0d ! Partition for 0d fields 161 INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 162 INTEGER :: id_part_temp ! Temperary partition used to choose either 0d or 1d partitions 143 163 INTEGER :: paral(5) ! OASIS3 box partition 144 INTEGER :: ishape(4) ! shape of arrays passed to PSMILe 164 INTEGER :: ishape(4) ! shape of 2D arrays passed to PSMILe 165 INTEGER :: ishape0d1d(2) ! Shape of 0D or 1D arrays passed to PSMILe. 166 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 167 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 168 ! but retained for backward compatibility. 169 ! var_nodims(2) is the number of fields in a bundle 170 ! or 1 for unbundled fields (bundles are not yet catered for 171 ! in NEMO hence we default to 1). 145 172 INTEGER :: ji,jc,jm ! local loop indicees 146 173 CHARACTER(LEN=64) :: zclname … … 185 212 ishape(3) = 1 186 213 ishape(4) = nlej-nldj+1 214 215 ishape0d1d(1) = 0 216 ishape0d1d(2) = 0 187 217 ! 188 218 ! ... Allocate memory for data exchange … … 211 241 212 242 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo ) 243 244 ! A special partition is needed for 0D fields 245 246 paral(1) = 0 ! serial partitioning 247 paral(2) = 0 248 IF ( nproc == 0) THEN 249 paral(3) = 1 ! Size of array to couple (scalar) 250 ELSE 251 paral(3) = 0 ! Dummy size for PE's not involved 252 END IF 253 paral(4) = 0 254 paral(5) = 0 255 256 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 257 258 ! Another partition is needed for 1D river routing fields 259 260 paral(1) = 0 ! serial partitioning 261 paral(2) = 0 262 IF ( nproc == 0) THEN 263 paral(3) = nn_cpl_river ! Size of array to couple (vector) 264 ELSE 265 paral(3) = 0 ! Dummy size for PE's not involved 266 END IF 267 paral(4) = 0 268 paral(5) = 0 269 270 271 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 272 213 273 ! 214 274 ! ... Announce send variables. … … 289 349 #endif 290 350 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 291 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 292 & OASIS_In , ishape , OASIS_REAL, nerror ) 351 flush(numout) 352 353 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 354 IF (srcv(ji)%dimensions <= 1) THEN 355 var_nodims(1) = 1 356 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 357 IF (nproc == 0) THEN 358 359 IF (srcv(ji)%dimensions == 0) THEN 360 361 ! If 0D then set temporary variables to 0D components 362 id_part_temp = id_part_0d 363 ishape0d1d(2) = 1 364 ELSE 365 366 ! If 1D then set temporary variables to river outflow components 367 id_part_temp = id_part_rnf_1d 368 ishape0d1d(2)= nn_cpl_river 369 370 END IF 371 372 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , var_nodims, & 373 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 374 ELSE 375 ! Dummy call to keep OASIS3-MCT happy. 376 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , var_nodims, & 377 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 378 END IF 379 ELSE 380 ! It's a "normal" 2D (or pseudo 3D) coupling field. 381 ! ... Set the field dimension and bundle count 382 var_nodims(1) = 2 383 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 384 385 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 386 & OASIS_In , ishape , OASIS_REAL, nerror ) 387 ENDIF 293 388 IF ( nerror /= OASIS_Ok ) THEN 294 389 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 471 566 472 567 568 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 569 !!--------------------------------------------------------------------- 570 !! *** ROUTINE cpl_rcv_1d *** 571 !! 572 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 573 !! receipt of 0D or 1D fields. 574 !! The fields are recieved into a 1D array buffer which is simply a 575 !! dynamically sized sized array (which may be of size 1) 576 !! of 0 dimensional fields. This allows us to pass miltiple 0D 577 !! fields via a single put/get operation. 578 !!---------------------------------------------------------------------- 579 INTEGER , INTENT(in ) :: nitems ! Number of 0D items to recieve 580 ! during this get operation. i.e. 581 ! The size of the 1D array in which 582 ! 0D items are passed. 583 INTEGER , INTENT(in ) :: kid ! ID index of the incoming 584 ! data. 585 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 586 REAL(wp), INTENT(inout) :: pdata(1:nitems) ! The original value(s), 587 ! unchanged if nothing is 588 ! received 589 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 590 !! 591 REAL(wp) :: recvfld(1:nitems) ! Local receive field buffer 592 INTEGER :: jc,jm ! local loop index 593 INTEGER :: ierr 594 LOGICAL :: llaction 595 INTEGER :: MPI_WORKING_PRECISION 596 INTEGER :: number_to_print 597 !!-------------------------------------------------------------------- 598 ! 599 ! receive local data from OASIS3 on every process 600 ! 601 kinfo = OASIS_idle 602 ! 603 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 604 ! so we only cater for a single set of values and thus don't bother 605 ! with a loop over the jc index 606 jc = 1 607 608 DO jm = 1, srcv(kid)%ncplmodel 609 610 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 611 612 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 613 ! Since there is no concept of data decomposition for zero 614 ! dimension fields, they must only be exchanged through the master PE, 615 ! unlike "normal" 2D field cases where every PE is involved. 616 617 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 618 619 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 620 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 621 622 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 623 llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 624 625 IF ( llaction ) THEN 626 627 kinfo = OASIS_Rcv 628 pdata(1:nitems) = recvfld(1:nitems) 629 630 IF ( ln_ctl ) THEN 631 number_to_print = 10 632 IF ( nitems < number_to_print ) number_to_print = nitems 633 WRITE(numout,*) '****************' 634 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 635 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 636 WRITE(numout,*) 'oasis_get: kstep', kstep 637 WRITE(numout,*) 'oasis_get: info ', kinfo 638 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 639 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 640 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 641 WRITE(numout,*) '****************' 642 ENDIF 643 644 ENDIF 645 ENDIF 646 ENDIF 647 648 ENDDO 649 650 #if defined key_mpp_mpi 651 ! Set the precision that we want to broadcast using MPI_BCAST 652 SELECT CASE( wp ) 653 CASE( sp ) 654 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 655 CASE( dp ) 656 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 657 CASE default 658 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 659 END SELECT 660 661 ! We have to broadcast (potentially) received values from PE 0 to all 662 ! the others. If no new data has been received we're just 663 ! broadcasting the existing values but there's no more efficient way 664 ! to deal with that w/o NEMO adopting a UM-style test mechanism 665 ! to determine active put/get timesteps. 666 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_oce, ierr ) 667 #else 668 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Unable to use mpi_bcast without key_mpp_mpi present. Please add key_mpp_mpi to your list of NEMO keys." ) 669 #endif 670 671 ! 672 END SUBROUTINE cpl_rcv_1d 673 674 473 675 INTEGER FUNCTION cpl_freq( cdfieldname ) 474 676 !!--------------------------------------------------------------------- … … 578 780 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 579 781 CHARACTER(*), INTENT(in ) :: cd1 580 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5( 2,2),k6782 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(*),k6 581 783 INTEGER , INTENT( out) :: k1,k7 582 784 k1 = -1 ; k7 = -1 … … 598 800 END SUBROUTINE oasis_put 599 801 600 SUBROUTINE oasis_get(k1,k2,p1,k3) 802 SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 803 REAL(wp), DIMENSION(:) , INTENT( out) :: p1 804 INTEGER , INTENT(in ) :: k1,k2 805 INTEGER , INTENT( out) :: k3 806 p1(1) = -1. ; k3 = -1 807 WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 808 END SUBROUTINE oasis_get_1d 809 810 SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 601 811 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 602 812 INTEGER , INTENT(in ) :: k1,k2 603 813 INTEGER , INTENT( out) :: k3 604 814 p1(1,1) = -1. ; k3 = -1 605 WRITE(numout,*) 'oasis_get : Error you sould not be there...'606 END SUBROUTINE oasis_get 815 WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 816 END SUBROUTINE oasis_get_2d 607 817 608 818 SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4)
Note: See TracChangeset
for help on using the changeset viewer.
