Changeset 5475
- Timestamp:
- 2015-06-24T16:04:14+02:00 (9 years ago)
- Location:
- branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
geo2ocean.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r5473 r5475 51 51 52 52 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 53 px2 , py2 )53 px2 , py2 , kchoix ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE repcmo *** … … 68 68 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 69 69 !!---------------------------------------------------------------------- 70 71 ! Change from geographic to stretched coordinate 72 ! ---------------------------------------------- 73 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 74 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 75 70 INTEGER, INTENT( IN ) :: & 71 kchoix ! type of transformation 72 ! = 1 change from geographic to model grid. 73 ! =-1 change from model to geographic grid 74 !!---------------------------------------------------------------------- 75 76 SELECT CASE (kchoix) 77 CASE ( 1) 78 ! Change from geographic to stretched coordinate 79 ! ---------------------------------------------- 80 81 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 82 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 83 CASE (-1) 84 ! Change from stretched to geographic coordinate 85 ! ---------------------------------------------- 86 87 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 88 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 89 END SELECT 90 76 91 END SUBROUTINE repcmo 77 92 -
branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5473 r5475 309 309 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 310 310 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 311 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 311 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 312 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 313 srcv(jpr_otx1)%laction = .TRUE. 314 srcv(jpr_oty1)%laction = .TRUE. 315 ! 312 316 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 313 317 CASE( 'T,I' ) … … 646 650 INTEGER :: ji, jj, jn ! dummy loop indices 647 651 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 652 INTEGER :: ikchoix 648 653 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 649 654 REAL(wp) :: zcoef ! temporary scalar … … 651 656 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 652 657 REAL(wp) :: zzx, zzy ! temporary variables 653 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 658 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty , ztx2, zty2 654 659 !!---------------------------------------------------------------------- 655 660 ! 656 661 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 657 662 ! 658 CALL wrk_alloc( jpi,jpj, ztx, zty )663 CALL wrk_alloc( jpi,jpj, ztx, zty , ztx2, zty2) 659 664 ! ! Receive all the atmos. fields (including ice information) 660 665 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges … … 689 694 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 690 695 ! ! (geographical to local grid -> rotate the components) 691 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 692 IF( srcv(jpr_otx2)%laction ) THEN 693 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 694 ELSE 695 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 696 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 697 ! Temporary code for HadGEM3 - will be removed eventually. 698 ! Only applies when we have only taux on U grid and tauy on V grid 699 DO jj=2,jpjm1 700 DO ji=2,jpim1 701 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 702 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 703 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 704 zty(ji,jj)=0.25*umask(ji,jj,1) & 705 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 706 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 707 ENDDO 708 ENDDO 709 710 ikchoix = 1 711 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 712 CALL lbc_lnk (ztx2,'U', -1. ) 713 CALL lbc_lnk (zty2,'V', -1. ) 714 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 715 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 716 ELSE 717 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 718 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 719 IF( srcv(jpr_otx2)%laction ) THEN 720 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 721 ELSE 722 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 723 ENDIF 724 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 696 725 ENDIF 697 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid698 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid699 726 ENDIF 700 727 ! … … 838 865 ENDIF 839 866 ! 840 CALL wrk_dealloc( jpi,jpj, ztx, zty 867 CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2) 841 868 ! 842 869 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1328 1355 ! 1329 1356 INTEGER :: ji, jj, jl ! dummy loop indices 1357 INTEGER :: ikchoix 1330 1358 INTEGER :: isec, info ! local integer 1331 1359 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 … … 1346 1374 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1347 1375 SELECT CASE( sn_snd_temp%cldes) 1376 CASE( 'none' ) ! nothing to do 1348 1377 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1349 1378 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) … … 1435 1464 ! j+1 j -----V---F 1436 1465 ! surface velocity always sent from T point ! | 1437 ! 1466 ! [except for HadGEM3] j | T U 1438 1467 ! | | 1439 1468 ! j j-1 -I-------| … … 1442 1471 ! i i+1 (for I) 1443 1472 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1444 CASE( 'oce only' ) ! C-grid ==> T 1445 DO jj = 2, jpjm1 1446 DO ji = fs_2, fs_jpim1 ! vector opt. 1447 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1448 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1449 END DO 1450 END DO 1473 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1474 DO jj = 2, jpjm1 1475 DO ji = fs_2, fs_jpim1 ! vector opt. 1476 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1477 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1478 END DO 1479 END DO 1480 ELSE 1481 ! Temporarily Changed for UKV 1482 DO jj = 2, jpjm1 1483 DO ji = 2, jpim1 1484 zotx1(ji,jj) = un(ji,jj,1) 1485 zoty1(ji,jj) = vn(ji,jj,1) 1486 END DO 1487 END DO 1488 ENDIF 1451 1489 CASE( 'weighted oce and ice' ) 1452 1490 SELECT CASE ( cp_ice_msh ) … … 1507 1545 END DO 1508 1546 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1509 DO jj = 2, jpjm1 1510 DO ji = 2, jpim1 ! NO vector opt. 1511 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1512 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1513 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1514 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1515 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1516 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1517 END DO 1518 END DO 1547 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1548 DO jj = 2, jpjm1 1549 DO ji = 2, jpim1 ! NO vector opt. 1550 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1551 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1552 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1553 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1554 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1555 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1556 END DO 1557 END DO 1558 #if defined key_cice 1559 ELSE 1560 ! Temporarily Changed for HadGEM3 1561 DO jj = 2, jpjm1 1562 DO ji = 2, jpim1 ! NO vector opt. 1563 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1564 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1565 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1566 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1567 END DO 1568 END DO 1569 #endif 1570 ENDIF 1519 1571 END SELECT 1520 1572 END SELECT … … 1524 1576 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1525 1577 ! ! Ocean component 1526 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1527 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1528 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1529 zoty1(:,:) = ztmp2(:,:) 1530 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1531 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1532 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1533 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1534 zity1(:,:) = ztmp2(:,:) 1535 ENDIF 1578 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1579 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1580 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1581 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1582 zoty1(:,:) = ztmp2(:,:) 1583 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1584 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1585 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1586 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1587 zity1(:,:) = ztmp2(:,:) 1588 ENDIF 1589 ELSE 1590 ! Temporary code for HadGEM3 - will be removed eventually. 1591 ! Only applies when we want uvel on U grid and vvel on V grid 1592 ! Rotate U and V onto geographic grid before sending. 1593 1594 DO jj=2,jpjm1 1595 DO ji=2,jpim1 1596 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 1597 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 1598 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 1599 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 1600 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 1601 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 1602 ENDDO 1603 ENDDO 1604 1605 ! Ensure any N fold and wrap columns are updated 1606 CALL lbc_lnk(ztmp1, 'V', -1.0) 1607 CALL lbc_lnk(ztmp2, 'U', -1.0) 1608 1609 ikchoix = -1 1610 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 1611 ENDIF 1536 1612 ENDIF 1537 1613 !
Note: See TracChangeset
for help on using the changeset viewer.
