Changeset 4354


Ignore:
Timestamp:
2014-01-17T17:56:32+01:00 (7 years ago)
Author:
jchanut
Message:

Restore AGRIF and BDY compatibility, see ticket #1133

Location:
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
Files:
14 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r4333 r4354  
    120120   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary 
    121121 
    122    REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh                  !:  
    123    REAL(wp), POINTER, DIMENSION(:,:)           ::   phur                  !:  
    124    REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr                  !: Pointers for barotropic fields  
    125    REAL(wp), POINTER, DIMENSION(:,:)           ::   pub2d, pun2d, pua2d   !:  
    126    REAL(wp), POINTER, DIMENSION(:,:)           ::   pvb2d, pvn2d, pva2d   !:  
    127  
    128122   !!---------------------------------------------------------------------- 
    129123   !! open boundary data variables 
     
    134128   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy) 
    135129   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
     130!$AGRIF_DO_NOT_TREAT 
    136131   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    137132   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    138  
     133!$AGRIF_END_DO_NOT_TREAT 
    139134   !!---------------------------------------------------------------------- 
    140135   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    153148      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     &   
    154149         &      STAT=bdy_oce_alloc ) 
    155          ! 
     150      ! 
     151      ! Initialize masks  
     152      bdytmask(:,:) = 1._wp 
     153      bdyumask(:,:) = 1._wp 
     154      bdyvmask(:,:) = 1._wp 
     155      !  
    156156      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc ) 
    157157      IF( bdy_oce_alloc /= 0 )   CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r4333 r4354  
    2020   !!    bdy_dta_init   : initialise arrays etc for reading of external data 
    2121   !!---------------------------------------------------------------------- 
    22    USE wrk_nemo        ! Memory Allocation 
    2322   USE timing          ! Timing 
    2423   USE oce             ! ocean dynamics and tracers 
     
    5150   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
    5251                                                               ! =F => baroclinic velocities in 3D boundary conditions 
    53  
     52!$AGRIF_DO_NOT_TREAT 
    5453   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read) 
    55  
     54!$AGRIF_END_DO_NOT_TREAT 
    5655   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
    5756 
     
    103102         ! Calculate depth-mean currents 
    104103         !----------------------------- 
    105          CALL wrk_alloc(jpi,jpj,pun2d,pvn2d)  
    106  
    107          pun2d(:,:) = 0.e0 
    108          pvn2d(:,:) = 0.e0 
    109          DO ik = 1, jpkm1   !! Vertically integrated momentum trends 
    110              pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
    111              pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
    112          END DO 
    113          pun2d(:,:) = pun2d(:,:) * hur(:,:) 
    114          pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 
    115104          
    116105         DO ib_bdy = 1, nb_bdy 
     
    135124                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    136125                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    137                      dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1)          
     126                     dta_bdy(ib_bdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)          
    138127                  END DO  
    139128               END IF 
     
    143132                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    144133                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    145                      dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1)          
     134                     dta_bdy(ib_bdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)          
    146135                  END DO  
    147136               END IF 
     
    156145                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    157146                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    158                         dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik)          
     147                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)          
    159148                     END DO 
    160149                  END DO  
     
    166155                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    167156                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    168                         dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik)          
     157                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)          
    169158                        END DO 
    170159                  END DO  
     
    262251         ENDDO ! ib_bdy 
    263252 
    264          CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d)  
    265253 
    266254      ENDIF ! kt .eq. nit000 
     
    919907   !!============================================================================== 
    920908END MODULE bdydta 
     909 
     910 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4317 r4354  
    6060      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    6161      !! 
    62       REAL(wp), POINTER, DIMENSION(:,:) :: phur1, phvr1     ! inverse depth at u and v points 
     62      REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities 
     63      REAL(wp), POINTER, DIMENSION(:,:) :: phura, phvra     ! after inverse depth at u and v points 
    6364 
    6465      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') 
     
    8182      !------------------------------------------------------- 
    8283 
    83       pssh => sshn 
    84       phur => hur 
    85       phvr => hvr 
    86       CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
    87       IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)  
     84      CALL wrk_alloc(jpi,jpj,pua2d,pva2d,phura,phvra)  
    8885 
    8986      !------------------------------------------------------- 
     
    9794       
    9895      IF (lk_vvl) THEN 
    99          phur(:,:) = 0. 
    100          phvr(:,:) = 0. 
     96         phura(:,:) = 0. 
     97         phvra(:,:) = 0. 
    10198         DO jk = 1, jpkm1 
    102             phur(:,:) = phur(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 
    103             phvr(:,:) = phvr(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 
     99            phura(:,:) = phura(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 
     100            phvra(:,:) = phvra(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 
    104101            pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    105102            pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    106103         END DO 
    107          phur(:,:) = umask(:,:,1) / ( phur(:,:) + 1. - umask(:,:,1) ) 
    108          phvr(:,:) = vmask(:,:,1) / ( phvr(:,:) + 1. - vmask(:,:,1) ) 
    109          pua2d(:,:) = pua2d(:,:) * phur(:,:) 
    110          pva2d(:,:) = pva2d(:,:) * phvr(:,:) 
     104         phura(:,:) = umask(:,:,1) / ( phura(:,:) + 1. - umask(:,:,1) ) 
     105         phvra(:,:) = vmask(:,:,1) / ( phvra(:,:) + 1. - vmask(:,:,1) ) 
    111106      ELSE 
     107         phura(:,:) = hur(:,:) 
     108         phvra(:,:) = hvr(:,:) 
    112109         DO jk = 1, jpkm1 
    113110            pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    114111            pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    115112         END DO 
    116          pua2d(:,:) = pua2d(:,:) * phur(:,:) 
    117          pva2d(:,:) = pva2d(:,:) * phvr(:,:) 
    118113      ENDIF 
     114      pua2d(:,:) = pua2d(:,:) * phura(:,:) 
     115      pva2d(:,:) = pva2d(:,:) * phvra(:,:) 
    119116 
    120117      DO jk = 1 , jpkm1 
     
    126123 
    127124      IF ( ll_orlanski ) THEN           
    128          pub2d(:,:) = 0.e0 
    129          pvb2d(:,:) = 0.e0 
    130  
    131          IF (lk_vvl) THEN 
    132             phur1(:,:) = 0. 
    133             phvr1(:,:) = 0. 
    134             DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    135                phur1(:,:) = phur1(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 
    136                phvr1(:,:) = phvr1(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
    137                pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
    138                pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
    139             END DO 
    140             phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) ) 
    141             phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) ) 
    142             pub2d(:,:) = pub2d(:,:) * phur1(:,:) 
    143             pvb2d(:,:) = pvb2d(:,:) * phvr1(:,:) 
    144          ELSE 
    145             DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    146                pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
    147                pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
    148             END DO 
    149             pub2d(:,:) = pub2d(:,:) * phur(:,:) 
    150             pvb2d(:,:) = pvb2d(:,:) * phvr(:,:) 
    151          ENDIF 
    152  
    153125         DO jk = 1 , jpkm1 
    154             ub(:,:,jk) = (ub(:,:,jk) - pub2d(:,:)) * umask(:,:,jk) 
    155             vb(:,:,jk) = (vb(:,:,jk) - pvb2d(:,:)) * vmask(:,:,jk) 
     126            ub(:,:,jk) = (ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk) 
     127            vb(:,:,jk) = (vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk) 
    156128         END DO 
    157129      END IF 
     
    162134      !------------------------------------------------------- 
    163135 
    164       IF( ll_dyn2d ) CALL bdy_dyn2d( kt ) 
     136      IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, phura, phvra, ssha ) 
    165137 
    166138      IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 
     
    177149      IF ( ll_orlanski ) THEN 
    178150         DO jk = 1 , jpkm1 
    179             ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk) 
    180             vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk) 
     151            ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk) 
     152            vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk) 
    181153         END DO 
    182154      END IF 
    183155 
    184       CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
    185       IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)  
     156      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d,phura,phvra)  
    186157 
    187158      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r4292 r4354  
    4141CONTAINS 
    4242 
    43    SUBROUTINE bdy_dyn2d( kt ) 
     43   SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                  ***  SUBROUTINE bdy_dyn2d  *** 
     
    4949      !!---------------------------------------------------------------------- 
    5050      INTEGER,                      INTENT(in) ::   kt   ! Main time step counter 
     51      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
     52      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d 
     53      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr 
     54      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh 
    5155      !! 
    5256      INTEGER                                  ::   ib_bdy ! Loop counter 
     
    5862            CYCLE 
    5963         CASE('frs') 
    60             CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
     64            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d ) 
    6165         CASE('flather') 
    62             CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
     66            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 
    6367         CASE('orlanski') 
    64             CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     68            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
     69                                     & pua2d, pva2d, pub2d, pvb2d, ll_npo=.false.) 
    6570         CASE('orlanski_npo') 
    66             CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
     71            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
     72                                     & pua2d, pva2d, pub2d, pvb2d, ll_npo=.true. ) 
    6773         CASE DEFAULT 
    6874            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
     
    7278   END SUBROUTINE bdy_dyn2d 
    7379 
    74    SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy ) 
     80   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d ) 
    7581      !!---------------------------------------------------------------------- 
    7682      !!                  ***  SUBROUTINE bdy_dyn2d_frs  *** 
     
    8692      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    8793      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     94      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
    8895      !! 
    8996      INTEGER  ::   jb, jk         ! dummy loop indices 
     
    118125 
    119126 
    120    SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy ) 
     127   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 
    121128      !!---------------------------------------------------------------------- 
    122129      !!                 ***  SUBROUTINE bdy_dyn2d_fla  *** 
     
    140147      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    141148      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
     149      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
     150      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr  
    142151 
    143152      INTEGER  ::   jb, igrd                         ! dummy loop indices 
     
    212221 
    213222 
    214    SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     223   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ll_npo ) 
    215224      !!---------------------------------------------------------------------- 
    216225      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
     
    226235      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    227236      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
     237      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
     238      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d  
    228239      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
    229240 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r4317 r4354  
    1515   !!---------------------------------------------------------------------- 
    1616   USE timing          ! Timing 
    17    USE wrk_nemo        ! Memory Allocation 
    1817   USE oce             ! ocean dynamics and tracers  
    1918   USE dom_oce         ! ocean space and time domain 
     
    266265      REAL(wp) ::   zwgt           ! boundary weight 
    267266      INTEGER  ::  ib_bdy          ! loop index 
    268       REAL(wp), POINTER, DIMENSION(:,:) :: phur1, phvr1     ! inverse depth at u and v points 
    269267      !!---------------------------------------------------------------------- 
    270268      ! 
     
    272270      ! 
    273271      !------------------------------------------------------- 
    274       ! Remove barotropic part from before velocity 
    275       !------------------------------------------------------- 
    276       CALL wrk_alloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)  
    277  
    278       pub2d(:,:) = 0.e0 
    279       pvb2d(:,:) = 0.e0 
    280  
    281       phur1(:,:) = 0. 
    282       phvr1(:,:) = 0. 
    283       DO jk = 1, jpkm1 
    284 #if defined key_vvl 
    285          phur1(:,:) = phur1(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 
    286          phvr1(:,:) = phvr1(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 
    287          pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)  
    288          pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk) 
    289 #else 
    290          pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk) 
    291          pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk) 
    292 #endif 
    293       END DO 
    294  
    295       IF( lk_vvl ) THEN 
    296          phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) ) 
    297          phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) ) 
    298          pub2d(:,:) = pub2d(:,:) * umask(:,:,1) * phur1(:,:) 
    299          pvb2d(:,:) = pvb2d(:,:) * vmask(:,:,1) * phvr1(:,:) 
    300       ELSE 
    301          pub2d(:,:) = pvb2d(:,:) * hur(:,:) 
    302          pvb2d(:,:) = pub2d(:,:) * hvr(:,:) 
    303       ENDIF 
    304272 
    305273      DO ib_bdy=1, nb_bdy 
     
    312280               DO jk = 1, jpkm1 
    313281                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 
    314                                    ub(ii,ij,jk) + pub2d(ii,ij)) ) * umask(ii,ij,jk) 
     282                                   ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk) 
    315283               END DO 
    316284            END DO 
     
    323291               DO jk = 1, jpkm1 
    324292                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  & 
    325                                    vb(ii,ij,jk) + pvb2d(ii,ij)) ) * vmask(ii,ij,jk) 
     293                                   vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk) 
    326294               END DO 
    327295            END DO 
     
    329297      ENDDO 
    330298      ! 
    331       CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)  
    332       ! 
    333299      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
    334300      ! 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4333 r4354  
    110110 
    111111      IF( nn_timing == 1 ) CALL timing_start('bdy_init') 
    112  
    113       IF( bdy_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' ) 
    114112 
    115113      IF(lwp) WRITE(numout,*) 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r4292 r4354  
    5151   END TYPE TIDES_DATA 
    5252 
     53!$AGRIF_DO_NOT_TREAT 
    5354   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data 
     55!$AGRIF_END_DO_NOT_TREAT 
    5456   TYPE(OBC_DATA)  , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
    5557 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r4313 r4354  
    7171      !!---------------------------------------------------------------------- 
    7272      ! - ML - needed for initialization of e3t_b 
    73       INTEGER  ::  jk     ! dummy loop indice 
     73      INTEGER  ::  ji,jj,jk     ! dummy loop indices 
     74      REAL(wp), POINTER, DIMENSION(:,:) ::  zhur_b, zhvr_b ! U & Inverse of before depths 
    7475      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::  zuvd    ! U & V data workspace 
    7576      !!---------------------------------------------------------------------- 
     
    155156      ENDIF 
    156157      ! 
     158      !  
     159      ! Initialize "now" and "before" barotropic velocities: 
     160      ! Do it whatever the free surface method, these arrays 
     161      ! being eventually used 
     162      ! 
     163      IF (lk_vvl) THEN  
     164         CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b  ) 
     165         zhur_b(:,:) = 0._wp 
     166         zhvr_b(:,:) = 0._wp 
     167         DO jk = 1, jpk 
     168            zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 
     169            zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
     170         END DO 
     171         zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) ) 
     172         zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) ) 
     173      ENDIF 
     174      ! 
     175      un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 
     176      ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 
     177      ! 
     178      DO jk = 1, jpkm1 
     179#if defined key_vectopt_loop 
     180         DO jj = 1, 1         !Vector opt. => forced unrolling 
     181            DO ji = 1, jpij 
     182#else  
     183         DO jj = 1, jpj 
     184            DO ji = 1, jpi 
     185#endif                   
     186               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     187               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     188               ! 
     189               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)  * umask(ji,jj,jk) 
     190               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)  * vmask(ji,jj,jk) 
     191            END DO 
     192         END DO 
     193      END DO 
     194      ! 
     195      un_b(:,:) = un_b(:,:) * hur(:,:) 
     196      vn_b(:,:) = vn_b(:,:) * hvr(:,:) 
     197      ! 
     198      IF( lk_vvl ) THEN 
     199         ub_b(:,:) = ub_b(:,:) * zhur_b(:,:) 
     200         vb_b(:,:) = vb_b(:,:) * zhvr_b(:,:) 
     201      ELSE 
     202         ub_b(:,:) = ub_b(:,:) * hur(:,:) 
     203         vb_b(:,:) = vb_b(:,:) * hvr(:,:) 
     204      ENDIF 
     205      ! 
     206      IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b  )  
     207      ! 
    157208      IF( nn_timing == 1 )  CALL timing_stop('istate_init') 
    158209      ! 
     
    537588   !!===================================================================== 
    538589END MODULE istate 
     590 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4338 r4354  
    102102      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec   ! local scalars 
    103103      REAL(wp) ::   zve3a, zve3n, zve3b, zvf        !   -      - 
    104       REAL(wp), POINTER, DIMENSION(:,:)   ::  zua, zva, zhura, zhvra 
     104      REAL(wp), POINTER, DIMENSION(:,:)   ::  zua, zva, zhura, zhvra, zhurb, zhvrb 
    105105      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f  
    106106      !!---------------------------------------------------------------------- 
     
    339339         ! 
    340340      ENDIF ! neuler =/0 
    341  
     341      ! 
     342      ! Set "now" and "before" barotropic velocities for next time step: 
     343      ! JC: Would be more clever to swap variables than to make a full vertical 
     344      ! integration 
     345      ! 
     346      IF (lk_vvl) THEN  
     347         CALL wrk_alloc( jpi, jpj, zhurb, zhvrb  ) 
     348         zhurb(:,:) = 0._wp 
     349         zhvrb(:,:) = 0._wp 
     350         DO jk = 1, jpk 
     351            zhurb(:,:) = zhurb(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 
     352            zhvrb(:,:) = zhvrb(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
     353         END DO 
     354         zhurb(:,:) = umask(:,:,1) / ( zhurb(:,:) + 1._wp - umask(:,:,1) ) 
     355         zhvrb(:,:) = vmask(:,:,1) / ( zhvrb(:,:) + 1._wp - vmask(:,:,1) ) 
     356      ENDIF 
     357      ! 
     358      un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 
     359      ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 
     360      ! 
     361      DO jk = 1, jpkm1 
     362#if defined key_vectopt_loop 
     363         DO jj = 1, 1         !Vector opt. => forced unrolling 
     364            DO ji = 1, jpij 
     365#else  
     366         DO jj = 1, jpj 
     367            DO ji = 1, jpi 
     368#endif                   
     369               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     370               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     371               ! 
     372               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)  * umask(ji,jj,jk) 
     373               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)  * vmask(ji,jj,jk) 
     374            END DO 
     375         END DO 
     376      END DO 
     377      ! 
     378      un_b(:,:) = un_b(:,:) * hur(:,:) 
     379      vn_b(:,:) = vn_b(:,:) * hvr(:,:) 
     380      ! 
     381      IF( lk_vvl ) THEN 
     382         ub_b(:,:) = ub_b(:,:) * zhurb(:,:) 
     383         vb_b(:,:) = vb_b(:,:) * zhvrb(:,:) 
     384      ELSE 
     385         ub_b(:,:) = ub_b(:,:) * hur(:,:) 
     386         vb_b(:,:) = vb_b(:,:) * hvr(:,:) 
     387      ENDIF 
     388      ! 
     389      IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhurb, zhvrb  )  
     390      ! 
    342391      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   & 
    343392         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
     
    352401   !!========================================================================= 
    353402END MODULE dynnxt 
     403 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r4292 r4354  
    3939   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_b           ! before field without time-filter 
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_b, va_b     ! after  averaged velocities 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b     ! now    averaged velocities 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b     ! before averaged velocities 
    4441   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv, vn_adv ! Advection vel. at "now" barocl. step 
    4542   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b,  vb2_b  ! Advection vel. at "now-0.5" barocl. step 
     
    5855      ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) ,      & 
    5956         &      ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) ,      & 
    60          &      ub_b(jpi,jpj)   , vb_b(jpi,jpj) , un_b(jpi,jpj) , vn_b(jpi,jpj)  ,      & 
    61          &      ua_b(jpi,jpj)   , va_b(jpi,jpj)                                  ,      &  
    6257         &      ub2_b(jpi,jpj)  , vb2_b(jpi,jpj)                                 ,      & 
    6358         &      un_adv(jpi,jpj) , vn_adv(jpi,jpj)                                ,      & 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4292 r4354  
    201201         IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend' 
    202202         IF(lwp) WRITE(numout,*) '~~~~~~~~~~   free surface with time splitting' 
    203          IF(lwp) WRITE(numout,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ',  2*nn_baro 
     203         IF(lwp) WRITE(numout,*) 
    204204         ! 
    205205         IF (neuler==0) ll_init=.TRUE. 
     
    317317      ! ----------------------------------------------------------------------------- 
    318318      !       
    319       ! Some vertical sums (at now and before time steps) below could be suppressed  
    320       ! if one swap barotropic arrays somewhere 
    321       ! 
    322       !                                   !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 
     319      ! 
     320      !                                   !* e3*d/dt(Ua) (Vertically integrated) 
    323321      !                                   ! -------------------------------------------------- 
    324       zu_frc(:,:) = 0._wp   ;   ub_b(:,:) = 0._wp  ;  un_b(:,:) = 0._wp 
    325       zv_frc(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp  ;  vn_b(:,:) = 0._wp 
     322      zu_frc(:,:) = 0._wp 
     323      zv_frc(:,:) = 0._wp 
    326324      ! 
    327325      DO jk = 1, jpkm1 
     
    332330         DO jj = 1, jpj 
    333331            DO ji = 1, jpi 
    334 #endif 
    335                !        ! now trend:                                                                    
     332#endif                                                                    
    336333               zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    337334               zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)          
    338                !        ! now bt transp:                    
    339                un_b(ji,jj) = un_b(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)         
    340                vn_b(ji,jj) = vn_b(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    341                !  ! before bt transp: 
    342                ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)  * umask(ji,jj,jk) 
    343                vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)  * vmask(ji,jj,jk) 
    344335            END DO 
    345336         END DO 
     
    349340      zv_frc(:,:) = zv_frc(:,:) * hvr(:,:) 
    350341      ! 
    351       IF( lk_vvl ) THEN 
    352           ub_b(:,:) = ub_b(:,:) * zhur_b(:,:) 
    353           vb_b(:,:) = vb_b(:,:) * zhvr_b(:,:) 
    354       ELSE 
    355           ub_b(:,:) = ub_b(:,:) * hur(:,:) 
    356           vb_b(:,:) = vb_b(:,:) * hvr(:,:) 
    357       ENDIF 
    358342      ! 
    359343      !                                   !* baroclinic momentum trend (remove the vertical mean trend) 
     
    368352      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    369353      !                                   ! -------------------------------------------------------- 
    370       zwx(:,:) = un_b(:,:) * e2u(:,:)           ! now transport  
    371       zwy(:,:) = vn_b(:,:) * e1v(:,:) 
     354      zwx(:,:) = un_b(:,:) * hu(:,:) * e2u(:,:)        ! now fluxes  
     355      zwy(:,:) = vn_b(:,:) * hv(:,:) * e1v(:,:) 
    372356      ! 
    373357      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme 
     
    412396      ENDIF  
    413397      ! 
    414       un_b (:,:) = un_b(:,:) * hur(:,:)         ! Revert now transport to barotropic velocities 
    415       vn_b (:,:) = vn_b(:,:) * hvr(:,:)   
    416398      !                                   !* Right-Hand-Side of the barotropic momentum equation 
    417399      !                                   ! ---------------------------------------------------- 
     
    511493      !                                             ! ==================== !   
    512494      ! Initialize barotropic variables:     
    513       IF (ln_bt_fw) THEN                  ! FORWARD integration:  start from NOW fields                              
     495      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                              
    514496         sshn_e (:,:) = sshn (:,:)             
    515497         zun_e  (:,:) = un_b (:,:)             
    516498         zvn_e  (:,:) = vn_b (:,:) 
    517       ELSE                                ! CENTERED integration: start from BEFORE fields 
     499      ELSE                                ! CENTRED integration: start from BEFORE fields 
    518500         sshn_e (:,:) = sshb (:,:) 
    519501         zun_e  (:,:) = ub_b (:,:)          
     
    807789 
    808790#if defined key_bdy   
    809  
    810          pssh => ssha_e 
    811          phur => hur_e 
    812          phvr => hvr_e 
    813          pua2d => ua_e 
    814          pva2d => va_e 
    815          pub2d => zun_e 
    816          pvb2d => zvn_e 
    817                                        
    818          IF( lk_bdy )   CALL bdy_dyn2d( kt )               ! open boundaries 
     791                                                           ! open boundaries 
     792         IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e ) 
    819793#endif 
    820794#if defined key_agrif 
     
    11181092         IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true.  => Forward integration of barotropic variables ' 
    11191093      ELSE 
    1120          IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centered integration of barotropic variables ' 
     1094         IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 
    11211095      ENDIF 
    11221096      ! 
     
    11681142   !!====================================================================== 
    11691143END MODULE dynspg_ts 
     1144 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r4292 r4354  
    2626   USE timing          ! Timing 
    2727   USE dynadv          ! dynamics: vector invariant versus flux form 
    28    USE dynspg_oce, ONLY: lk_dynspg_ts, ua_b, va_b 
     28   USE dynspg_oce, ONLY: lk_dynspg_ts 
    2929   USE dynspg_ts 
    3030 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4328 r4354  
    618618      USE diadct    , ONLY: diadct_alloc  
    619619#endif  
     620#if defined key_bdy 
     621      USE bdy_oce   , ONLY: bdy_oce_alloc 
     622#endif 
    620623      ! 
    621624      INTEGER :: ierr 
     
    634637      ierr = ierr + diadct_alloc    ()          !  
    635638#endif  
     639#if defined key_bdy 
     640      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization) 
     641#endif 
    636642      ! 
    637643      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    819825   !!====================================================================== 
    820826END MODULE nemogcm 
     827 
     828 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4292 r4354  
    3535 
    3636   !! free surface                                      !  before  ! now    ! after  ! 
    37    !! ------------                                      !  fields  ! fields ! trends ! 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m] 
     37   !! ------------                                      !  fields  ! fields ! fields ! 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s] 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s] 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m] 
    3941   ! 
    4042   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient 
     
    8385      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         & 
    8486         &     rhop(jpi,jpj,jpk) ,                                         & 
    85          &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     & 
     87         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     & 
     88         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     & 
     89         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     & 
    8690         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
    8791         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
Note: See TracChangeset for help on using the changeset viewer.