Changeset 10041 for branches/UKMO
- Timestamp:
- 2018-08-07T12:17:06+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
cpl_oasis3.F90 (modified) (14 diffs)
-
sbccpl.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r9279 r10041 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 … … 153 154 INTEGER :: id_part 154 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) 155 159 INTEGER :: paral(5) ! OASIS3 box partition 156 160 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe … … 228 232 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 229 233 230 231 234 ! Another partition is needed for 1D river routing fields 235 236 paral(1) = 0 ! serial partitioning 237 paral(2) = 0 238 IF ( nproc == 0) THEN 239 paral(3) = nn_cpl_river ! Size of array to couple (vector) 240 ELSE 241 paral(3) = 0 ! Dummy size for PE's not involved 242 END IF 243 paral(4) = 0 244 paral(5) = 0 245 246 247 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 248 232 249 ! 233 250 ! ... Announce send variables. … … 310 327 flush(numout) 311 328 312 ! If it's Greenland or Antarctic ice mass then define a 0D field 313 IF (srcv(ji)%dimensions == 0) THEN 314 WRITE(numout,*) "RSRH 0d define field ",zclname; flush(numout) 315 ! Define 0D coupling fields 316 IF (nproc == 0) THEN 317 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , (/ 1, 0 /), & 318 OASIS_In , (/ 1, 1 /) , OASIS_REAL, nerror ) 329 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 330 IF (srcv(ji)%dimensions <= 1) THEN 331 WRITE(numout,*) "RSRH 0d or 1d define field ",zclname; flush(numout) 332 IF (nproc == 0) THEN 333 334 IF (srcv(ji)%dimensions == 0) THEN 335 336 ! If 0D then set temporary variables to 0D components 337 id_part_temp = id_part_0d 338 vector_length = 1 339 ELSE 340 341 ! If 1D then set temporary variables to river outflow components 342 id_part_temp = id_part_rnf_1d 343 vector_length = nn_cpl_river 344 345 END IF 346 347 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , (/ 1, 0 /), & 348 OASIS_In , (/ 1, vector_length /) , OASIS_REAL, nerror ) 319 349 ELSE 320 350 ! Dummy call to keep OASIS3-MCT happy. … … 428 458 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 429 459 430 431 IF (( srcv(kid)%dimensions /= 0) .OR. & 432 (( srcv(kid)%dimensions == 0) .AND. nproc == 0)) THEN 433 ! Zero dimension fields must only be exchanged through the master PE. 434 ! In normal 2D cases, every PE is involved. 435 436 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 460 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 437 461 438 439 462 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 463 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 440 464 441 465 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 442 466 443 467 IF ( llaction ) THEN 444 468 445 469 kinfo = OASIS_Rcv … … 462 486 WRITE(numout,*) '****************' 463 487 ENDIF 464 465 466 ENDIF 488 489 ENDIF 490 467 491 ENDIF 468 492 … … 482 506 !! 483 507 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 484 !! receipt of 0D fields.508 !! receipt of 0D or 1D fields. 485 509 !! The fields are recieved into a 1D array buffer which is simply a 486 510 !! dynamically sized sized array (which may be of size 1) … … 504 528 INTEGER :: ierr 505 529 LOGICAL :: llaction 530 INTEGER :: MPI_WORKING_PRECISION 531 INTEGER :: number_to_print 506 532 !!-------------------------------------------------------------------- 507 533 ! … … 510 536 kinfo = OASIS_idle 511 537 ! 512 ! 0D fields won't have categories or any other form of "pseudo level"538 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 513 539 ! so we only cater for a single set of values and thus don't bother 514 540 ! with a loop over the jc index … … 519 545 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 520 546 521 IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN547 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 522 548 ! Since there is no concept of data decomposition for zero 523 549 ! dimension fields, they must only be exchanged through the master PE, … … 538 564 539 565 IF ( ln_ctl ) THEN 566 number_to_print = 10 567 IF ( nitems < number_to_print ) number_to_print = nitems 540 568 WRITE(numout,*) '****************' 541 569 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname … … 545 573 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 546 574 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 575 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 547 576 WRITE(numout,*) '****************' 548 577 ENDIF … … 553 582 554 583 ENDDO 584 585 ! Set the precision that we want to broadcast using MPI_BCAST 586 SELECT CASE( wp ) 587 CASE( sp ) 588 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 589 CASE( dp ) 590 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 591 CASE default 592 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 593 END SELECT 555 594 556 595 ! We have to broadcast (potentially) received values from PE 0 to all … … 559 598 ! to deal with that w/o NEMO adopting a UM-style test mechanism 560 599 ! to determine active put/get timesteps. 561 CALL mpi_bcast( pdata, nitems, MPI_ Real, localRoot, mpi_comm_opa, ierr )600 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 562 601 563 602 ! -
branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r9280 r10041 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 ! Incoming atm aggregate dust 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) 177 INTEGER :: nn_cpl_river ! Number of rivers to be dealt with in atmos-ocean coupling.178 179 179 180 TYPE :: DYNARR … … 468 469 ! ! ------------------------- ! 469 470 srcv(jpr_rnf )%clname = 'O_Runoff' 470 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 471 srcv(jpr_rnf)%laction = .TRUE. 471 srcv(jpr_rnf_1d )%clname = 'runoffo' 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 472 478 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 473 479 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas … … 673 679 ENDIF 674 680 ENDIF 675 676 ! =================================================== !677 ! Allocate all parts of frcv used for received fields !678 ! =================================================== !679 DO jn = 1, jprcv680 681 IF ( srcv(jn)%laction ) THEN682 IF ( srcv(jn)%dimensions == 0 ) THEN683 WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout)684 685 ! We have a scalar field686 ALLOCATE( frcv(jn)%z3(1,1,1) )687 ELSE688 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout)689 ! We have a "normal" 2D (or pseudo 3D) field.690 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )691 END IF692 END IF693 694 END DO695 ! Allocate taum part of frcv which is used even when not received as coupling field696 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )697 ! Allocate w10m part of frcv which is used even when not received as coupling field698 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )699 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field700 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )701 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )702 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.703 IF( k_ice /= 0 ) THEN704 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )705 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )706 END IF707 681 708 682 ! ================================ ! … … 971 945 ENDIF 972 946 ENDIF 947 948 ! Initialise 1D river outflow scheme 949 nn_cpl_river = 1 950 IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init ! Coupled runoff using 1D array 951 952 ! =================================================== ! 953 ! Allocate all parts of frcv used for received fields ! 954 ! =================================================== ! 955 DO jn = 1, jprcv 956 957 IF ( srcv(jn)%laction ) THEN 958 SELECT CASE( srcv(jn)%dimensions ) 959 ! 960 CASE( 0 ) ! Scalar field 961 WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 962 963 ! We have a scalar field 964 ALLOCATE( frcv(jn)%z3(1,1,1) ) 965 966 CASE( 1 ) ! 1D field 967 968 ! In the special case of 1D fields we can't allocate the array yet as 969 ! we don't know what nn_cpl_river is. 970 WRITE(numout,*) "RSRH allocate 1 dim field z3",jn, nn_cpl_river ; flush(numout) 971 972 ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 973 974 CASE DEFAULT 975 976 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 977 ! We have a "normal" 2D (or pseudo 3D) field. 978 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 979 END SELECT 980 END IF 981 982 END DO 983 ! Allocate taum part of frcv which is used even when not received as coupling field 984 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 985 ! Allocate w10m part of frcv which is used even when not received as coupling field 986 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 987 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 988 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 989 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 990 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 991 IF( k_ice /= 0 ) THEN 992 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 993 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 994 END IF 973 995 974 996 ! … … 1107 1129 1108 1130 IF ( srcv(jn)%dimensions == 0 ) THEN 1109 write(numout,*) "RSRH recieving 0d field",kt,jn ; flush(numout)1131 write(numout,*) "RSRH recieving 0d or 1d field",kt,jn ; flush(numout) 1110 1132 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1111 1133 ELSE … … 1425 1447 write(numout,*) "RSRH still in cpl_rcv inside teswt for grnm",kt ; flush(numout) 1426 1448 1427 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum1428 1449 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1429 1450 … … 1460 1481 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1461 1482 1462 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum1463 1483 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1464 1484 … … 1861 1881 ! --- runoffs (included in emp later on) --- ! 1862 1882 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1883 IF( srcv(jpr_rnf_1d)%laction ) CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1863 1884 1864 1885 ! --- calving (put in emp_tot and emp_oce) --- ! … … 1898 1919 ! runoffs and calving (put in emp_tot) 1899 1920 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1921 IF( srcv(jpr_rnf_1d)%laction ) CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1900 1922 IF( iom_use('hflx_rnf_cea') ) & 1901 1923 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) )
Note: See TracChangeset
for help on using the changeset viewer.
