Changeset 9218 for branches/UKMO
- Timestamp:
- 2018-01-12T16:22:43+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
cpl_oasis3.F90 (modified) (9 diffs)
-
sbccpl.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r8280 r9218 39 39 PUBLIC cpl_snd 40 40 PUBLIC cpl_rcv 41 PUBLIC cpl_rcv_1d 41 42 PUBLIC cpl_freq 42 43 PUBLIC cpl_finalize … … 88 89 INTEGER :: nct ! Number of categories in field 89 90 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 91 INTEGER :: dimensions ! Number of dimensions of coupling field 90 92 END TYPE FLD_CPL 91 93 … … 150 152 ! 151 153 INTEGER :: id_part 154 INTEGER :: id_part_0d ! Partition for 0d fields 152 155 INTEGER :: paral(5) ! OASIS3 box partition 153 156 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe … … 210 213 211 214 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 215 216 ! A special partition is needed for 0D fields 217 218 paral(1) = 0 ! serial partitioning 219 paral(2) = 0 220 IF ( nproc == 0) THEN 221 paral(3) = 1 ! Size of array to couple (scalar) 222 ELSE 223 paral(3) = 0 ! Dummy size for PE's not involved 224 END IF 225 paral(4) = 0 226 paral(5) = 0 227 228 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 229 230 231 212 232 ! 213 233 ! ... Announce send variables. … … 288 308 #endif 289 309 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 290 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 291 & OASIS_In , ishape , OASIS_REAL, nerror ) 310 flush(numout) 311 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 ) 319 ELSE 320 ! Dummy call to keep OASIS3-MCT happy. 321 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , (/ 1, 0 /), & 322 OASIS_In , (/ 0, 0 /) , OASIS_REAL, nerror ) 323 END IF 324 WRITE(numout,*) "RSRH 0d field done ",zclname,nerror; flush(numout) 325 ELSE 326 WRITE(numout,*) "RSRH 2d define field ",zclname; flush(numout) 327 ! It's a "normal" 2D (or pseudo 3D) coupling field. 328 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 329 OASIS_In , ishape , OASIS_REAL, nerror ) 330 WRITE(numout,*) "RSRH 2d field done ",zclname,nerror; flush(numout) 331 ENDIF 332 292 333 IF ( nerror /= OASIS_Ok ) THEN 293 334 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 305 346 ! End of definition phase 306 347 !------------------------------------------------------------------ 307 348 WRITE(numout,*) "RSRH NEMO calling enddef";flush(numout) 308 349 CALL oasis_enddef(nerror) 350 WRITE(numout,*) "RSRH NEMO finished enddef", nerror;flush(numout) 309 351 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 310 352 ! … … 386 428 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 387 429 388 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 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 ) 389 437 390 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &438 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 391 439 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 392 440 393 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)441 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 394 442 395 IF ( llaction ) THEN443 IF ( llaction ) THEN 396 444 397 445 kinfo = OASIS_Rcv … … 415 463 ENDIF 416 464 417 ENDIF418 465 ENDIF 466 ENDIF 419 467 ENDIF 420 468 … … 428 476 ! 429 477 END SUBROUTINE cpl_rcv 478 479 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, items, kinfo ) 480 !!--------------------------------------------------------------------- 481 !! *** ROUTINE cpl_rcv_1d *** 482 !! 483 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 484 !! 1D fields. The one dimension in this sense does not represent any spatial 485 !! dimension, it merely represents an arbitrary number of single values 486 !! i.e. the fields recieved are simply an array (which may be of size 1) 487 !! of 0 dimensional fields. 488 !!---------------------------------------------------------------------- 489 INTEGER , INTENT(in ) :: items ! variable index in the array 490 INTEGER , INTENT(in ) :: kid ! variable index in the array 491 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 492 REAL(wp), INTENT(inout) :: pdata(1:items) ! IN to keep the value if nothing is done 493 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 494 !! 495 REAL(wp) :: recvfld(1:items) ! Received field 496 INTEGER :: jc,jm ! local loop index 497 INTEGER :: ierr 498 LOGICAL :: llaction, llfisrt 499 !!-------------------------------------------------------------------- 500 ! 501 ! receive local data from OASIS3 on every process 502 ! 503 kinfo = OASIS_idle 504 ! 505 jc = 1 506 507 DO jm = 1, srcv(kid)%ncplmodel 508 509 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 510 511 512 IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN 513 ! Zero dimension fields must only be exchanged through the master PE. 514 ! In normal 2D cases, every PE is involved. 515 516 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 517 518 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 519 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 520 521 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 522 523 IF ( llaction ) THEN 524 525 kinfo = OASIS_Rcv 526 pdata(1:items) = recvfld(1:items) 527 528 IF ( ln_ctl ) THEN 529 WRITE(numout,*) '****************' 530 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 531 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 532 WRITE(numout,*) 'oasis_get: kstep', kstep 533 WRITE(numout,*) 'oasis_get: info ', kinfo 534 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 535 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 536 WRITE(numout,*) '****************' 537 ENDIF 538 539 ENDIF 540 ENDIF 541 ENDIF 542 543 ENDDO 544 write(numout,*) "RSRH call bcast for 0D size",items;flush(numout) 545 546 ! There are no halos to deal with but we do have to broadcast values from PE 0 to all the 547 ! others. 548 CALL mpi_bcast( pdata, items, MPI_Real, localRoot, mpi_comm_opa, ierr ) 549 write(numout,*) "RSRH done bcast for 0D";flush(numout) 550 551 ! 552 END SUBROUTINE cpl_rcv_1d 430 553 431 554 -
branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8427 r9218 339 339 340 340 ! default definitions of srcv 341 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 341 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 ; srcv(:)%dimensions = 2 342 342 343 343 ! ! ------------------------- ! … … 468 468 ENDIF 469 469 ! 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. 470 srcv(jpr_cal )%clname = 'OCalving' 471 IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 472 srcv(jpr_grnm )%clname = 'OGrnmass' 473 srcv(jpr_grnm )%dimensions = 0 ! Scalar field 474 write(numout,*) "RSRH set up grnmss dimension:" 475 476 477 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 478 srcv(jpr_antm )%clname = 'OAntmass' 479 srcv(jpr_antm )%dimensions = 0 ! Scalar field 480 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 473 481 474 482 … … 662 670 ! =================================================== ! 663 671 DO jn = 1, jprcv 664 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 672 673 IF ( srcv(jn)%laction ) THEN 674 IF ( srcv(jn)%dimensions == 0 ) THEN 675 WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 676 677 ! We have a scalar field 678 ALLOCATE( frcv(jn)%z3(1,1,1) ) 679 ELSE 680 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 681 ! We have a "normal" 2D (or pseudo 3D) field. 682 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 683 END IF 684 END IF 685 665 686 END DO 666 687 ! Allocate taum part of frcv which is used even when not received as coupling field … … 685 706 686 707 ! default definitions of nsnd 687 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 708 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 ; ssnd(:)%dimensions = 2 688 709 689 710 ! ! ------------------------- ! … … 1067 1088 ! 1068 1089 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1090 write(numout,*) "RSRH in cpl_rcv",kt ; flush(numout) 1069 1091 ! 1070 1092 ! ! ======================================================= ! … … 1073 1095 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 1074 1096 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) ) 1097 IF( srcv(jn)%laction ) THEN 1098 write(numout,*) "RSRH recieving field via call to cpl_rcv",kt,jn ; flush(numout) 1099 1100 IF ( srcv(jn)%dimensions == 0 ) THEN 1101 write(numout,*) "RSRH recieving 0d field",kt,jn ; flush(numout) 1102 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1103 ELSE 1104 write(numout,*) "RSRH recieving 2d field",kt,jn ; flush(numout) 1105 CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1106 END IF 1107 write(numout,*) "RSRH completed recieve of field via call to cpl_rcv",kt,jn ; flush(numout) 1108 1109 END IF 1076 1110 END DO 1077 1111 write(numout,*) "RSRH still in cpl_rcv",kt ; flush(numout) 1078 1112 ! ! ========================= ! 1079 1113 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! … … 1376 1410 zmask_sum = glob_sum( tmask(:,:,1) ) 1377 1411 ENDIF 1412 write(numout,*) "RSRH still in cpl_rcv at teswt for grnm",kt ; flush(numout) 1378 1413 1379 1414 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) ) 1415 ! This is a zero dimensional, single value field. 1416 zgreenland_icesheet_mass_in = frcv(jpr_grnm)%z3(1,1,1) 1417 write(numout,*) "RSRH still in cpl_rcv inside teswt for grnm",kt ; flush(numout) 1384 1418 1385 1419 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum … … 1415 1449 ! ! land ice masses : Antarctica 1416 1450 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) ) 1451 ! This is a zero dimensional, single value field. 1452 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1421 1453 1422 1454 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum
Note: See TracChangeset
for help on using the changeset viewer.
