Changeset 7463


Ignore:
Timestamp:
2016-12-06T17:03:05+01:00 (4 years ago)
Author:
jcastill
Message:

Changes as in branches/UKMO/dev_r5107_hadgem3_cplfld

Location:
branches/r6232_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
2 edited

Legend:

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

    r7462 r7463  
    5151 
    5252   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    53                        px2 , py2 ) 
     53                       px2 , py2, kchoix ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE repcmo  *** 
     
    6767      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point) 
    6868      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
    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 ) 
     69      INTEGER, INTENT( IN )                       ::   kchoix       ! type of transformation   
     70                                                                    ! = 1 change from geographic to model grid.   
     71                                                                    ! =-1 change from model to geographic grid   
     72      !!----------------------------------------------------------------------  
     73        
     74      SELECT CASE (kchoix)   
     75      CASE ( 1)   
     76        ! Change from geographic to stretched coordinate   
     77        ! ----------------------------------------------   
     78        
     79        CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 )   
     80        CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 )   
     81      CASE (-1)   
     82        ! Change from stretched to geographic coordinate   
     83        ! ----------------------------------------------   
     84        
     85        CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 )   
     86        CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 )   
     87      END SELECT   
    7588       
    7689   END SUBROUTINE repcmo 
  • branches/r6232_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7462 r7463  
    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, ztx2, zty2, zmsk, zemp, zqns, zqsr 
    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, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 
    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            !                               
     
    11131140      ENDIF 
    11141141      ! 
    1115       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1142      CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 
    11161143      ! 
    11171144      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    17081735      ! 
    17091736      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     1737      INTEGER ::   ikchoix 
    17101738      INTEGER ::   isec, info   ! local integer 
    17111739      REAL(wp) ::   zumax, zvmax 
     
    17651793                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    17661794               ENDDO 
     1795            CASE( 'none'         )       ! nothing to do 
    17671796            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    17681797            END SELECT 
     
    18891918         !                                                  j+1   j     -----V---F 
    18901919         ! surface velocity always sent from T point                     !       | 
    1891          !                                                        j      |   T   U 
     1920         ! [except for HadGEM3]                                   j      |   T   U 
    18921921         !                                                               |       | 
    18931922         !                                                   j    j-1   -I-------| 
     
    19011930            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    19021931            CASE( 'oce only'             )      ! C-grid ==> T 
    1903                DO jj = 2, jpjm1 
    1904                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1905                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1906                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1907                   END DO 
    1908                END DO 
     1932               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN   
     1933                  DO jj = 2, jpjm1   
     1934                     DO ji = fs_2, fs_jpim1   ! vector opt.   
     1935                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )   
     1936                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) )    
     1937                     END DO   
     1938                  END DO   
     1939               ELSE   
     1940                  ! Temporarily Changed for UKV   
     1941                  DO jj = 2, jpjm1   
     1942                     DO ji = 2, jpim1   
     1943                        zotx1(ji,jj) = un(ji,jj,1)   
     1944                        zoty1(ji,jj) = vn(ji,jj,1)   
     1945                     END DO   
     1946                  END DO   
     1947               ENDIF    
    19091948            CASE( 'weighted oce and ice' )    
    19101949               SELECT CASE ( cp_ice_msh ) 
     
    19301969                  END DO 
    19311970               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1932                   DO jj = 2, jpjm1 
    1933                      DO ji = 2, jpim1   ! NO vector opt. 
    1934                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1935                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1936                         zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1937                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1938                         zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1939                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1940                      END DO 
    1941                   END DO 
     1971                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN   
     1972                     DO jj = 2, jpjm1   
     1973                        DO ji = 2, jpim1   ! NO vector opt.   
     1974                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &      
     1975                                  &       + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &   
     1976                                  &                + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)   
     1977                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   &   
     1978                                  &       + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &   
     1979                                  &                + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)   
     1980                        END DO   
     1981                     END DO   
     1982#if defined key_cice   
     1983                  ELSE   
     1984                     ! Temporarily Changed for HadGEM3   
     1985                     DO jj = 2, jpjm1   
     1986                        DO ji = 2, jpim1   ! NO vector opt.   
     1987                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             &   
     1988                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )    
     1989                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             &   
     1990                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )    
     1991                        END DO   
     1992                     END DO   
     1993#endif   
     1994                  ENDIF   
    19421995               END SELECT 
    19431996               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     
    19842037         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    19852038            !                                                                     ! Ocean component 
    1986             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    1987             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    1988             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    1989             zoty1(:,:) = ztmp2(:,:) 
    1990             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    1991                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    1992                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    1993                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    1994                zity1(:,:) = ztmp2(:,:) 
    1995             ENDIF 
     2039             IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN   
     2040                CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component   
     2041                CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component   
     2042                zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components   
     2043                zoty1(:,:) = ztmp2(:,:)   
     2044                IF( ssnd(jps_ivx1)%laction ) THEN                  ! Ice component   
     2045                   CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component   
     2046                   CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component   
     2047                   zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components   
     2048                   zity1(:,:) = ztmp2(:,:)   
     2049                ENDIF   
     2050             ELSE   
     2051                ! Temporary code for HadGEM3 - will be removed eventually.   
     2052                ! Only applies when we want uvel on U grid and vvel on V grid   
     2053                ! Rotate U and V onto geographic grid before sending.   
     2054             
     2055                DO jj=2,jpjm1   
     2056                   DO ji=2,jpim1   
     2057                      ztmp1(ji,jj)=0.25*vmask(ji,jj,1)      &   
     2058                           *(zotx1(ji,jj)+zotx1(ji-1,jj)    &   
     2059                           +zotx1(ji,jj+1)+zotx1(ji-1,jj+1))   
     2060                      ztmp2(ji,jj)=0.25*umask(ji,jj,1)      &   
     2061                           *(zoty1(ji,jj)+zoty1(ji+1,jj)    &   
     2062                           +zoty1(ji,jj-1)+zoty1(ji+1,jj-1))   
     2063                   ENDDO   
     2064                ENDDO   
     2065                   
     2066                ! Ensure any N fold and wrap columns are updated   
     2067                CALL lbc_lnk(ztmp1, 'V', -1.0)   
     2068                CALL lbc_lnk(ztmp2, 'U', -1.0)   
     2069                   
     2070                ikchoix = -1   
     2071                CALL repcmo(zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix)   
     2072            ENDIF   
    19962073         ENDIF 
    19972074         ! 
Note: See TracChangeset for help on using the changeset viewer.