Changeset 10395


Ignore:
Timestamp:
2018-12-14T15:58:02+01:00 (2 years ago)
Author:
jcastill
Message:

Merge branch r6232_hadgem3_cplfld@7463

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

Legend:

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

    r8058 r10395  
    5151 
    5252   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    53                        px2 , py2 ) 
     53                       px2 , py2, kchoix ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE repcmo  *** 
     
    6969      !!---------------------------------------------------------------------- 
    7070       
    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 ) 
     71      INTEGER, INTENT( IN )                       ::   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    
    7590       
    7691   END SUBROUTINE repcmo 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r10394 r10395  
    342342         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    343343         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    344          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     344         !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2   
     345         ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment   
     346         srcv(jpr_otx1)%laction = .TRUE.    
     347         srcv(jpr_oty1)%laction = .TRUE.   
     348         !   
    345349         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    346350      CASE( 'T,I' )  
     
    850854      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    851855      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     856      INTEGER  ::   ikchoix 
    852857      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    853858      REAL(wp) ::   zcoef                  ! temporary scalar 
     
    855860      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    856861      REAL(wp) ::   zzx, zzy               ! temporary variables 
    857       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     862      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr 
    858863      !!---------------------------------------------------------------------- 
    859864      ! 
    860865      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    861866      ! 
    862       CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     867      CALL wrk_alloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 
    863868      ! 
    864869      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    898903            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    899904               !                                                       ! (geographical to local grid -> rotate the components) 
    900                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    901                IF( srcv(jpr_otx2)%laction ) THEN 
    902                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    903                ELSE   
    904                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     905               IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN    
     906                  ! Temporary code for HadGEM3 - will be removed eventually.    
     907                  ! Only applies when we have only taux on U grid and tauy on V grid    
     908                  DO jj=2,jpjm1    
     909                     DO ji=2,jpim1    
     910                        ztx(ji,jj)=0.25*vmask(ji,jj,1) &    
     911                           *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1)    &    
     912                           +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1))    
     913                        zty(ji,jj)=0.25*umask(ji,jj,1) &    
     914                           *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1)    &    
     915                           +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1))    
     916                     ENDDO    
     917                  ENDDO    
     918                               
     919                  ikchoix = 1    
     920                  CALL repcmo(frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix)    
     921                  CALL lbc_lnk (ztx2,'U', -1. )    
     922                  CALL lbc_lnk (zty2,'V', -1. )    
     923                  frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:)    
     924                  frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:)    
     925               ELSE    
     926                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )       
     927                  frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid    
     928                  IF( srcv(jpr_otx2)%laction ) THEN    
     929                     CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )       
     930                  ELSE    
     931                     CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )     
     932                  ENDIF    
     933                  frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    905934               ENDIF 
    906                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    907                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    908935            ENDIF 
    909936            !                               
     
    11181145      ENDIF 
    11191146      ! 
    1120       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1147      CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 
    11211148      ! 
    11221149      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    17131740      ! 
    17141741      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     1742      INTEGER ::   ikchoix 
    17151743      INTEGER ::   isec, info   ! local integer 
    17161744      REAL(wp) ::   zumax, zvmax 
     
    17701798                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    17711799               ENDDO 
     1800            CASE( 'none'         )       ! nothing to do 
    17721801            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    17731802            END SELECT 
     
    18941923         !                                                  j+1   j     -----V---F 
    18951924         ! surface velocity always sent from T point                     !       | 
    1896          !                                                        j      |   T   U 
     1925         ! [except for HadGEM3]                                   j      |   T   U 
    18971926         !                                                               |       | 
    18981927         !                                                   j    j-1   -I-------| 
     
    19061935            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    19071936            CASE( 'oce only'             )      ! C-grid ==> T 
    1908                DO jj = 2, jpjm1 
    1909                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1910                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1911                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1912                   END DO 
    1913                END DO 
     1937               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN    
     1938                  DO jj = 2, jpjm1    
     1939                     DO ji = fs_2, fs_jpim1   ! vector opt.    
     1940                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )    
     1941                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) )     
     1942                     END DO    
     1943                  END DO    
     1944               ELSE    
     1945                  ! Temporarily Changed for UKV    
     1946                  DO jj = 2, jpjm1    
     1947                     DO ji = 2, jpim1    
     1948                        zotx1(ji,jj) = un(ji,jj,1)    
     1949                        zoty1(ji,jj) = vn(ji,jj,1)    
     1950                     END DO    
     1951                  END DO    
     1952               ENDIF  
    19141953            CASE( 'weighted oce and ice' )    
    19151954               SELECT CASE ( cp_ice_msh ) 
     
    19351974                  END DO 
    19361975               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1937                   DO jj = 2, jpjm1 
    1938                      DO ji = 2, jpim1   ! NO vector opt. 
    1939                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1940                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1941                         zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1942                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1943                         zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1944                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1945                      END DO 
    1946                   END DO 
     1976                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN    
     1977                     DO jj = 2, jpjm1    
     1978                        DO ji = 2, jpim1   ! NO vector opt.    
     1979                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &       
     1980                                  &       + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &    
     1981                                  &                + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)    
     1982                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   &    
     1983                                  &       + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &    
     1984                                  &                + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)    
     1985                        END DO    
     1986                     END DO    
     1987#if defined key_cice    
     1988                  ELSE    
     1989                     ! Temporarily Changed for HadGEM3    
     1990                     DO jj = 2, jpjm1    
     1991                        DO ji = 2, jpim1   ! NO vector opt.    
     1992                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             &    
     1993                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )     
     1994                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             &    
     1995                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )     
     1996                        END DO    
     1997                     END DO    
     1998#endif    
     1999                  ENDIF  
    19472000               END SELECT 
    19482001               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     
    19892042         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    19902043            !                                                                     ! Ocean component 
    1991             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    1992             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    1993             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    1994             zoty1(:,:) = ztmp2(:,:) 
    1995             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    1996                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    1997                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    1998                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    1999                zity1(:,:) = ztmp2(:,:) 
    2000             ENDIF 
     2044             IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN    
     2045                CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component    
     2046                CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component    
     2047                zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components    
     2048                zoty1(:,:) = ztmp2(:,:)    
     2049                IF( ssnd(jps_ivx1)%laction ) THEN                  ! Ice component    
     2050                   CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component    
     2051                   CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component    
     2052                   zitx1(:,:) = ztmp1(:,:) ! overwrite the components    
     2053                   zity1(:,:) = ztmp2(:,:)    
     2054                ENDIF    
     2055             ELSE    
     2056                ! Temporary code for HadGEM3 - will be removed eventually.    
     2057                ! Only applies when we want uvel on U grid and vvel on V grid    
     2058                ! Rotate U and V onto geographic grid before sending.    
     2059              
     2060                DO jj=2,jpjm1    
     2061                   DO ji=2,jpim1    
     2062                      ztmp1(ji,jj)=0.25*vmask(ji,jj,1)      &    
     2063                           *(zotx1(ji,jj)+zotx1(ji-1,jj)    &    
     2064                           +zotx1(ji,jj+1)+zotx1(ji-1,jj+1))    
     2065                      ztmp2(ji,jj)=0.25*umask(ji,jj,1)      &    
     2066                           *(zoty1(ji,jj)+zoty1(ji+1,jj)    &    
     2067                           +zoty1(ji,jj-1)+zoty1(ji+1,jj-1))    
     2068                   ENDDO    
     2069                ENDDO    
     2070                    
     2071                ! Ensure any N fold and wrap columns are updated    
     2072                CALL lbc_lnk(ztmp1, 'V', -1.0)    
     2073                CALL lbc_lnk(ztmp2, 'U', -1.0)    
     2074                    
     2075                ikchoix = -1    
     2076                CALL repcmo(zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix)    
     2077            ENDIF    
    20012078         ENDIF 
    20022079         ! 
Note: See TracChangeset for help on using the changeset viewer.