- Timestamp:
- 2018-11-01T11:35:45+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
- 1 copied
-
cpl_oasis3.F90 (modified) (13 diffs)
-
cpl_rnf_1d.F90 (copied) (copied from branches/UKMO/dev_r5518_GO6_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_rnf_1d.F90)
-
sbccpl.F90 (modified) (16 diffs)
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) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r9321 r10269 46 46 USE eosbn2 47 47 USE sbcrnf , ONLY : l_rnfcpl 48 USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d ! Variables used in 1D river outflow 48 49 #if defined key_cpl_carbon_cycle 49 50 USE p4zflx, ONLY : oce_co2 … … 111 112 INTEGER, PARAMETER :: jpr_atm_pco2 = 46 ! Incoming atm CO2 flux 112 113 INTEGER, PARAMETER :: jpr_atm_dust = 47 ! Incoming atm aggregate dust 113 INTEGER, PARAMETER :: jprcv = 47 ! total number of fields received 114 INTEGER, PARAMETER :: jpr_rnf_1d = 48 ! 1D river runoff 115 INTEGER, PARAMETER :: jprcv = 48 ! total number of fields received 114 116 115 117 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 175 177 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 176 178 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 179 177 180 TYPE :: DYNARR 178 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 253 256 NAMELIST/namsbc_cpl/ sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro, & 254 257 & sn_rcv_atm_pco2, sn_rcv_atm_dust 258 255 259 256 260 !!--------------------------------------------------------------------- … … 324 328 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 325 329 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 330 326 331 ENDIF 327 332 … … 339 344 340 345 ! default definitions of srcv 341 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 346 srcv(:)%laction = .FALSE. 347 srcv(:)%clgrid = 'T' 348 srcv(:)%nsgn = 1. 349 srcv(:)%nct = 1 350 srcv(:)%dimensions = 2 342 351 343 352 ! ! ------------------------- ! … … 460 469 ! ! ------------------------- ! 461 470 srcv(jpr_rnf )%clname = 'O_Runoff' 462 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 463 srcv(jpr_rnf)%laction = .TRUE. 471 srcv(jpr_rnf_1d )%clname = 'ORunff1D' 472 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 473 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 474 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 475 srcv(jpr_rnf_1d)%laction = .TRUE. 476 srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 477 END IF 464 478 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 465 479 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas … … 468 482 ENDIF 469 483 ! 470 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 471 srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 472 srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 484 srcv(jpr_cal )%clname = 'OCalving' 485 IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 486 487 srcv(jpr_grnm )%clname = 'OGrnmass' 488 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm)%laction = .TRUE. 489 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm )%dimensions = 0 ! Scalar field 490 491 srcv(jpr_antm )%clname = 'OAntmass' 492 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_antm%cldes ) == 'coupled0d' ) srcv(jpr_antm)%laction = .TRUE. 493 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled0d' ) srcv(jpr_antm )%dimensions = 0 ! Scalar field 494 473 495 474 496 … … 657 679 ENDIF 658 680 ENDIF 659 660 ! =================================================== !661 ! Allocate all parts of frcv used for received fields !662 ! =================================================== !663 DO jn = 1, jprcv664 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )665 END DO666 ! Allocate taum part of frcv which is used even when not received as coupling field667 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )668 ! Allocate w10m part of frcv which is used even when not received as coupling field669 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )670 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field671 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )672 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )673 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.674 IF( k_ice /= 0 ) THEN675 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )676 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )677 END IF678 681 679 682 ! ================================ ! … … 683 686 ! define send or not from the namelist parameters (ssnd(:)%laction) 684 687 ! define the north fold type of lbc (ssnd(:)%nsgn) 685 688 686 689 ! default definitions of nsnd 687 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 688 690 ssnd(:)%laction = .FALSE. 691 ssnd(:)%clgrid = 'T' 692 ssnd(:)%nsgn = 1. 693 ssnd(:)%nct = 1 694 ssnd(:)%dimensions = 2 695 689 696 ! ! ------------------------- ! 690 697 ! ! Surface temperature ! … … 942 949 ENDIF 943 950 ENDIF 951 952 ! Initialise 1D river outflow scheme 953 nn_cpl_river = 1 954 IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init ! Coupled runoff using 1D array 955 956 ! =================================================== ! 957 ! Allocate all parts of frcv used for received fields ! 958 ! =================================================== ! 959 DO jn = 1, jprcv 960 961 IF ( srcv(jn)%laction ) THEN 962 SELECT CASE( srcv(jn)%dimensions ) 963 ! 964 CASE( 0 ) ! Scalar field 965 ALLOCATE( frcv(jn)%z3(1,1,1) ) 966 967 CASE( 1 ) ! 1D field 968 ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 969 970 CASE DEFAULT ! 2D (or pseudo 3D) field. 971 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 972 973 END SELECT 974 END IF 975 976 END DO 977 ! Allocate taum part of frcv which is used even when not received as coupling field 978 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 979 ! Allocate w10m part of frcv which is used even when not received as coupling field 980 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 981 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 982 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 983 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 984 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 985 IF( k_ice /= 0 ) THEN 986 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 987 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 988 END IF 944 989 945 990 ! … … 1073 1118 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 1074 1119 DO jn = 1, jprcv ! received fields sent by the atmosphere 1075 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1120 IF( srcv(jn)%laction ) THEN 1121 1122 IF ( srcv(jn)%dimensions <= 1 ) THEN 1123 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1124 ELSE 1125 CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1126 END IF 1127 1128 END IF 1076 1129 END DO 1077 1078 1130 ! ! ========================= ! 1079 1131 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! … … 1378 1430 1379 1431 IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1380 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1381 ! take average over ocean points of input array to avoid cumulative error over time 1382 ! The following must be bit reproducible over different PE decompositions 1383 zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1384 1385 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1432 1433 IF( srcv(jpr_grnm)%dimensions == 0 ) THEN 1434 1435 ! This is a zero dimensional, single value field. 1436 zgreenland_icesheet_mass_in = frcv(jpr_grnm)%z3(1,1,1) 1437 1438 ELSE 1439 1440 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1441 ! take average over ocean points of input array to avoid cumulative error over time 1442 ! The following must be bit reproducible over different PE decompositions 1443 zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1444 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1445 1446 END IF 1447 1386 1448 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1387 1449 … … 1415 1477 ! ! land ice masses : Antarctica 1416 1478 IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1417 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1418 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1419 ! The following must be bit reproducible over different PE decompositions 1420 zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1421 1422 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1479 1480 IF( srcv(jpr_antm)%dimensions == 0 ) THEN 1481 1482 ! This is a zero dimensional, single value field. 1483 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1484 1485 ELSE 1486 1487 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1488 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1489 ! The following must be bit reproducible over different PE decompositions 1490 zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1491 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1492 1493 END IF 1494 1423 1495 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1424 1496 … … 1821 1893 ! --- runoffs (included in emp later on) --- ! 1822 1894 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1895 IF( srcv(jpr_rnf_1d)%laction ) CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1823 1896 1824 1897 ! --- calving (put in emp_tot and emp_oce) --- ! … … 1858 1931 ! runoffs and calving (put in emp_tot) 1859 1932 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1933 IF( srcv(jpr_rnf_1d)%laction ) CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1860 1934 IF( iom_use('hflx_rnf_cea') ) & 1861 1935 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) )
Note: See TracChangeset
for help on using the changeset viewer.
