Changeset 5475


Ignore:
Timestamp:
2015-06-24T16:04:14+02:00 (5 years ago)
Author:
cguiavarch
Message:

Changes currently required to deal with non-standard aspects of the UM coupling fields.

Location:
branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r5473 r5475  
    5151 
    5252   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    53                        px2 , py2 ) 
     53                       px2 , py2 , kchoix  ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE repcmo  *** 
     
    6868      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
    6969      !!---------------------------------------------------------------------- 
    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      
    7691   END SUBROUTINE repcmo 
    7792 
  • branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5473 r5475  
    309309         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    310310         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! 
    312316         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    313317      CASE( 'T,I' )  
     
    646650      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    647651      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     652      INTEGER  ::   ikchoix 
    648653      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    649654      REAL(wp) ::   zcoef                  ! temporary scalar 
     
    651656      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    652657      REAL(wp) ::   zzx, zzy               ! temporary variables 
    653       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     658      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty , ztx2, zty2 
    654659      !!---------------------------------------------------------------------- 
    655660      ! 
    656661      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    657662      ! 
    658       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
     663      CALL wrk_alloc( jpi,jpj, ztx, zty , ztx2, zty2) 
    659664      !                                                 ! Receive all the atmos. fields (including ice information) 
    660665      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
     
    689694            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    690695               !                                                       ! (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   
    696725               ENDIF 
    697                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    698                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    699726            ENDIF 
    700727            !                               
     
    838865      ENDIF 
    839866      ! 
    840       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     867      CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2) 
    841868      ! 
    842869      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    13281355      ! 
    13291356      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     1357      INTEGER ::   ikchoix 
    13301358      INTEGER ::   isec, info   ! local integer 
    13311359      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
     
    13461374      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    13471375         SELECT CASE( sn_snd_temp%cldes) 
     1376         CASE( 'none'         )       ! nothing to do 
    13481377         CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    13491378         CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
     
    14351464         !                                                  j+1   j     -----V---F 
    14361465         ! surface velocity always sent from T point                     !       | 
    1437          !                                                        j      |   T   U 
     1466         ! [except for HadGEM3]                                   j      |   T   U 
    14381467         !                                                               |       | 
    14391468         !                                                   j    j-1   -I-------| 
     
    14421471         !                                                               i      i+1 (for I) 
    14431472         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  
    14511489         CASE( 'weighted oce and ice' )    
    14521490            SELECT CASE ( cp_ice_msh ) 
     
    15071545               END DO 
    15081546            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 
    15191571            END SELECT 
    15201572         END SELECT 
     
    15241576         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    15251577            !                                                                     ! 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 
    15361612         ENDIF 
    15371613         ! 
Note: See TracChangeset for help on using the changeset viewer.