- Timestamp:
- 2018-01-12T16:22:43+01:00 (6 years ago)
- File:
-
- 1 edited
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
Note: See TracChangeset
for help on using the changeset viewer.
