Changeset 6561


Ignore:
Timestamp:
2016-05-18T15:16:52+02:00 (6 years ago)
Author:
frrh
Message:

Update with changes from dev_r5107_hadgem3_cplfld@5490

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

Legend:

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

    r6560 r6561  
    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_r5518_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6560 r6561  
    337337         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    338338         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    339          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     339         !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     340! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 
     341         srcv(jpr_otx1)%laction = .TRUE.  
     342         srcv(jpr_oty1)%laction = .TRUE. 
     343! 
    340344         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    341345      CASE( 'T,I' )  
     
    845849      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    846850      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     851      INTEGER  ::   ikchoix 
    847852      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    848853      REAL(wp) ::   zcoef                  ! temporary scalar 
     
    850855      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    851856      REAL(wp) ::   zzx, zzy               ! temporary variables 
    852       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     857      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    853858      !!---------------------------------------------------------------------- 
    854859      ! 
    855860      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    856861      ! 
    857       CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     862      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    858863      ! 
    859864      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    893898            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    894899               !                                                       ! (geographical to local grid -> rotate the components) 
    895                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    896                IF( srcv(jpr_otx2)%laction ) THEN 
    897                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    898                ELSE   
    899                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     900               IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 
     901                  ! Temporary code for HadGEM3 - will be removed eventually. 
     902        ! Only applies when we have only taux on U grid and tauy on V grid 
     903             DO jj=2,jpjm1 
     904                DO ji=2,jpim1 
     905                     ztx(ji,jj)=0.25*vmask(ji,jj,1)                & 
     906                        *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1)    & 
     907                        +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 
     908                     zty(ji,jj)=0.25*umask(ji,jj,1)                & 
     909                        *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1)    & 
     910                        +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 
     911                ENDDO 
     912             ENDDO 
     913                    
     914             ikchoix = 1 
     915             CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 
     916             CALL lbc_lnk (ztx2,'U', -1. ) 
     917             CALL lbc_lnk (zty2,'V', -1. ) 
     918             frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 
     919             frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 
     920          ELSE 
     921             CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     922             frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     923             IF( srcv(jpr_otx2)%laction ) THEN 
     924                CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     925             ELSE 
     926                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
     927             ENDIF 
     928          frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid   
    900929               ENDIF 
    901                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    902                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    903930            ENDIF 
    904931            !                               
     
    11111138      ENDIF 
    11121139      ! 
    1113       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1140      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    11141141      ! 
    11151142      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    17061733      ! 
    17071734      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     1735      INTEGER ::   ikchoix 
    17081736      INTEGER ::   isec, info   ! local integer 
    17091737      REAL(wp) ::   zumax, zvmax 
     
    18581886         !                                                  j+1   j     -----V---F 
    18591887         ! surface velocity always sent from T point                     !       | 
    1860          !                                                        j      |   T   U 
     1888         ! [except for HadGEM3]                                   j      |   T   U 
    18611889         !                                                               |       | 
    18621890         !                                                   j    j-1   -I-------| 
     
    18701898            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    18711899            CASE( 'oce only'             )      ! C-grid ==> T 
    1872                DO jj = 2, jpjm1 
    1873                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1874                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1875                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     1900               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     1901                  DO jj = 2, jpjm1 
     1902                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1903                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1904                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     1905                     END DO 
    18761906                  END DO 
    1877                END DO 
     1907               ELSE 
     1908! Temporarily Changed for UKV 
     1909                  DO jj = 2, jpjm1 
     1910                     DO ji = 2, jpim1 
     1911                        zotx1(ji,jj) = un(ji,jj,1) 
     1912                        zoty1(ji,jj) = vn(ji,jj,1) 
     1913                     END DO 
     1914                  END DO 
     1915               ENDIF  
    18781916            CASE( 'weighted oce and ice' )    
    18791917               SELECT CASE ( cp_ice_msh ) 
     
    19341972                  END DO 
    19351973               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1936                   DO jj = 2, jpjm1 
    1937                      DO ji = 2, jpim1   ! NO vector opt. 
    1938                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1939                            &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1940                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1941                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1942                            &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1943                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1974                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     1975                     DO jj = 2, jpjm1 
     1976                        DO ji = 2, jpim1   ! NO vector opt. 
     1977                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
     1978                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1979                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1980                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
     1981                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1982                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1983                        END DO 
    19441984                     END DO 
    1945                   END DO 
     1985#if defined key_cice 
     1986                  ELSE 
     1987! Temporarily Changed for HadGEM3 
     1988                     DO jj = 2, jpjm1 
     1989                        DO ji = 2, jpim1   ! NO vector opt. 
     1990                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
     1991                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
     1992                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
     1993                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     1994                        END DO 
     1995                     END DO 
     1996#endif 
     1997                  ENDIF 
    19461998               END SELECT 
    19471999            END SELECT 
     
    19532005         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    19542006            !                                                                     ! Ocean component 
    1955             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    1956             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    1957             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    1958             zoty1(:,:) = ztmp2(:,:) 
    1959             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    1960                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    1961                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    1962                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    1963                zity1(:,:) = ztmp2(:,:) 
    1964             ENDIF 
     2007            IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2008               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2009               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2010               zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2011               zoty1(:,:) = ztmp2(:,:) 
     2012               IF( ssnd(jps_ivx1)%laction ) THEN                                  ! Ice component 
     2013                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2014                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2015                  zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2016                  zity1(:,:) = ztmp2(:,:) 
     2017               ENDIF 
     2018            ELSE 
     2019               ! Temporary code for HadGEM3 - will be removed eventually. 
     2020               ! Only applies when we want uvel on U grid and vvel on V grid 
     2021               ! Rotate U and V onto geographic grid before sending. 
     2022 
     2023               DO jj=2,jpjm1 
     2024                  DO ji=2,jpim1 
     2025                     ztmp1(ji,jj)=0.25*vmask(ji,jj,1)                  & 
     2026                          *(zotx1(ji,jj)+zotx1(ji-1,jj)    & 
     2027                          +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 
     2028                     ztmp2(ji,jj)=0.25*umask(ji,jj,1)                  & 
     2029                          *(zoty1(ji,jj)+zoty1(ji+1,jj)    & 
     2030                          +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 
     2031                  ENDDO 
     2032               ENDDO 
     2033                
     2034               ! Ensure any N fold and wrap columns are updated 
     2035               CALL lbc_lnk(ztmp1, 'V', -1.0) 
     2036               CALL lbc_lnk(ztmp2, 'U', -1.0) 
     2037                
     2038               ikchoix = -1 
     2039               CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 
     2040           ENDIF 
    19652041         ENDIF 
    19662042         ! 
Note: See TracChangeset for help on using the changeset viewer.