New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/OBC
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90

    r2528 r2715  
    44   !! Open Boundary Cond. :   define related variables 
    55   !!============================================================================== 
     6   !! history :  OPA  ! 1991-01 (CLIPPER)  Original code  
     7   !!   NEMO     1.0  ! 2002-02 (C. Talandier)  modules, F90 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_obc 
    610   !!---------------------------------------------------------------------- 
    711   !!   'key_obc' :                                 Open Boundary Condition 
    812   !!---------------------------------------------------------------------- 
    9    !! history : 
    10    !!  8.0   01/91   (CLIPPER)  Original code  
    11    !!  8.5   06/02   (C. Talandier)  modules 
    12    !!        06/04   (F. Durand) ORCA2_ZIND config 
    13    !!                  
    14    !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    1613   USE par_oce         ! ocean parameters 
    1714   USE obc_par         ! open boundary condition parameters 
    1815 
    19 #if defined key_obc 
    20  
    2116   IMPLICIT NONE 
    2217   PUBLIC 
     18    
     19   PUBLIC   obc_oce_alloc   ! called by obcini.F90 module 
    2320 
    2421   !!---------------------------------------------------------------------- 
    … …  
    2623   !!---------------------------------------------------------------------- 
    2724   ! 
    28    !                                  !!* Namelist namobc: open boundary condition * 
     25   !                                            !!* Namelist namobc: open boundary condition * 
    2926   INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data 
    3027   !                                             !   = 1 read obc data in obcxxx.dta files 
    … …  
    6360   !!General variables for open boundaries: 
    6461   !!-------------------------------------- 
    65    LOGICAL ::              &  !: 
    66       lfbceast, lfbcwest,  &  !: logical flag for a fixed East and West open boundaries        
    67       lfbcnorth, lfbcsouth    !: logical flag for a fixed North and South open boundaries        
    68       !                       !  These logical flags are set to 'true' if damping time  
    69       !                       !  scale are set to 0 in the namelist, for both inflow and outflow). 
     62   LOGICAL ::   lfbceast, lfbcwest      !: logical flag for a fixed East and West open boundaries        
     63   LOGICAL ::   lfbcnorth, lfbcsouth    !: logical flag for a fixed North and South open boundaries        
     64   !                                    !  These logical flags are set to 'true' if damping time  
     65   !                                    !  scale are set to 0 in the namelist, for both inflow and outflow). 
    7066 
    7167   REAL(wp), PUBLIC ::   obcsurftot       !: Total lateral surface of open boundaries 
    7268    
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &  !: 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: &  !: 
    7470      obctmsk,            &  !: mask array identical to tmask, execpt along OBC where it is set to 0 
    7571      !                      !  it used to calculate the cumulate flux E-P in the obcvol.F90 routine 
    … …  
    8783   INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed 
    8884 
    89    REAL(wp), DIMENSION(jpj) ::   &  !: 
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    9086      sshfoe,           & !: now climatology of the east boundary sea surface height 
    9187      ubtfoe,vbtfoe       !: now climatology of the east boundary barotropic transport 
    9288      
    93    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     89   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    9490      ufoe, vfoe,       & !: now climatology of the east boundary velocities  
    9591      tfoe, sfoe,       & !: now climatology of the east boundary temperature and salinity 
    … …  
    9793      !                   ! in the obcdyn.F90 routine 
    9894 
    99    REAL(wp), DIMENSION(jpi,jpj) ::   sshfoe_b      !: east boundary ssh correction averaged over the barotropic loop 
     95   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfoe_b   !: east boundary ssh correction averaged over the barotropic loop 
    10096      !                                            !  (if Flather's algoritm applied at open boundary) 
    10197 
    … …  
    10399   !! Arrays for radiative East OBC:  
    104100   !!------------------------------- 
    105    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
    106102      !                                                    !  and 3 time step (now, before, and before before) 
    107    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
    108104      !                                                    !  and 2 time step (now and before) 
    109    REAL(wp), DIMENSION(jpj,jpk) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
     105   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
    110106      !                                                    !  radiation of u and v velocity (respectively) at the  
    111107      !                                                    !  east open boundary (u_cxebnd = cx rdt ) 
    112    REAL(wp), DIMENSION(jpj,jpk) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
     108   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
    113109 
    114110   ! Note that those arrays are optimized for mpp case  
    … …  
    124120   INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd 
    125121 
    126    REAL(wp), DIMENSION(jpj) ::   &  !: 
     122   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    127123      sshfow,           & !: now climatology of the west boundary sea surface height 
    128124      ubtfow,vbtfow       !: now climatology of the west boundary barotropic transport 
    129125 
    130    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     126   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    131127      ufow, vfow,       & !: now climatology of the west velocities  
    132128      tfow, sfow,       & !: now climatology of the west temperature and salinity 
    … …  
    134130      !                   !  in the obcdyn.F90 routine 
    135131 
    136    REAL(wp), DIMENSION(jpi,jpj) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
     132   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
    137133      !                                          !  (if Flather's algoritm applied at open boundary) 
    138134 
    … …  
    140136   !! Arrays for radiative West OBC 
    141137   !!------------------------------- 
    142    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
     138   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
    143139      !                                                   !  and 3 time step (now, before, and before before) 
    144    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
     140   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
    145141      !                                                   !  2 time step (now and before) 
    146    REAL(wp), DIMENSION(jpj,jpk) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
     142   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
    147143      !                                                   !  radiation of zonal and meridional velocity (respectively)  
    148144      !                                                   !  at the west open boundary (u_cxwbnd = cx rdt ) 
    149    REAL(wp), DIMENSION(jpj,jpk) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
     145   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
    150146 
    151147   ! Note that those arrays are optimized for mpp case  
    … …  
    162158   INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1 
    163159 
    164    REAL(wp), DIMENSION(jpi) ::   &  !: 
     160   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    165161      sshfon,           & !: now climatology of the north boundary sea surface height 
    166162      ubtfon,vbtfon       !: now climatology of the north boundary barotropic transport 
    167163 
    168    REAL(wp), DIMENSION(jpi,jpk) ::   &    !: 
     164   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &    !: 
    169165      ufon, vfon,       & !: now climatology of the north boundary velocities 
    170166      tfon, sfon,       & !: now climatology of the north boundary temperature and salinity 
    … …  
    172168      !                   !  in yhe obcdyn.F90 routine 
    173169 
    174    REAL(wp), DIMENSION(jpi,jpj) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
     170   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
    175171      !                                            !  (if Flather's algoritm applied at open boundary) 
    176172 
    … …  
    178174   !! Arrays for radiative North OBC 
    179175   !!-------------------------------- 
    180    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
     176   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
    181177      !                                                    !  rows and 3 time step (now, before, and before before) 
    182    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
     178   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
    183179      !                                                    !  2 rows and 2 time step (now and before) 
    184    REAL(wp), DIMENSION(jpi,jpk) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
     180   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
    185181      !                                                    !  ted with radiation of zonal and meridional velocity  
    186182      !                                                    !  (respectively) at the north OB (u_cynbnd = cx rdt ) 
    187    REAL(wp), DIMENSION(jpi,jpk) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
     183   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
    188184 
    189185   ! Note that those arrays are optimized for mpp case  
    … …  
    199195   INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1 
    200196 
    201    REAL(wp), DIMENSION(jpi) ::    &   !: 
     197   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::    &   !: 
    202198      sshfos,           & !: now climatology of the south boundary sea surface height 
    203199      ubtfos,vbtfos       !: now climatology of the south boundary barotropic transport 
    204200 
    205    REAL(wp), DIMENSION(jpi,jpk) ::    &   !: 
     201   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::    &   !: 
    206202      ufos, vfos,       & !: now climatology of the south boundary velocities  
    207203      tfos, sfos,       & !: now climatology of the south boundary temperature and salinity 
    … …  
    209205      !                   !  in the obcdyn.F90 routine 
    210206 
    211    REAL(wp), DIMENSION(jpi,jpj) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
     207   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
    212208      !                                           !  (if Flather's algoritm applied at open boundary) 
    213209 
    … …  
    215211   !! Arrays for radiative South OBC   (computed by the forward time step in dynspg) 
    216212   !!-------------------------------- 
    217    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
     213   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
    218214      !                                                   !  rows and 3 time step (now, before, and before before) 
    219    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
     215   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
    220216      !                                                   !  2 rows and 2 time step (now and before) 
    221    REAL(wp), DIMENSION(jpi,jpk) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
     217   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
    222218      !                                                   !  computed with radiation of zonal and meridional velocity  
    223219      !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt ) 
    224    REAL(wp), DIMENSION(jpi,jpk) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
    225  
    226 #else 
    227    !!---------------------------------------------------------------------- 
    228    !!   Default option :                                       Empty module 
    229    !!---------------------------------------------------------------------- 
    230 #endif 
     220   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
    231221 
    232222   !!---------------------------------------------------------------------- 
    … …  
    234224   !! $Id$  
    235225   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     226   !!---------------------------------------------------------------------- 
     227CONTAINS 
     228 
     229   INTEGER FUNCTION obc_oce_alloc() 
     230      !!---------------------------------------------------------------------- 
     231      !!               ***  FUNCTION obc_oce_alloc  *** 
     232      !!---------------------------------------------------------------------- 
     233 
     234      ALLOCATE(                                                               & 
     235              !! East open boundary 
     236              obctmsk(jpi,jpj), obcumask(jpi,jpj), obcvmask(jpi,jpj),        & 
     237              sshfoe(jpjed:jpjef), ubtfoe(jpjed:jpjef), vbtfoe(jpjed:jpjef), & 
     238              ufoe(jpj,jpk), vfoe(jpj,jpk), tfoe(jpj,jpk), sfoe(jpj,jpk),    & 
     239              uclie(jpj,jpk), sshfoe_b(jpjed:jpjef,jpj),                     & 
     240              !! Arrays for radiative East OBC 
     241              uebnd(jpj,jpk,3,3), vebnd(jpj,jpk,3,3) ,                       & 
     242              tebnd(jpj,jpk,2,2), sebnd(jpj,jpk,2,2),                        & 
     243              u_cxebnd(jpj,jpk), v_cxebnd(jpj,jpk),                          & 
     244              uemsk(jpj,jpk), vemsk(jpj,jpk), temsk(jpj,jpk),                & 
     245              !! West open boundary 
     246              sshfow(jpjwd:jpjwf), ubtfow(jpjwd:jpjwf), vbtfow(jpjwd:jpjwf), & 
     247              ufow(jpj,jpk), vfow(jpj,jpk), tfow(jpj,jpk),                   & 
     248              sfow(jpj,jpk), ucliw(jpj,jpk), sshfow_b(jpjwd:jpjwf,jpj),      & 
     249              !! Arrays for radiative West OBC 
     250              uwbnd(jpj,jpk,3,3), vwbnd(jpj,jpk,3,3),                        & 
     251              twbnd(jpj,jpk,2,2), swbnd(jpj,jpk,2,2),                        & 
     252              u_cxwbnd(jpj,jpk), v_cxwbnd(jpj,jpk),                          & 
     253              uwmsk(jpj,jpk), vwmsk(jpj,jpk), twmsk(jpj,jpk),                & 
     254              !! North open boundary 
     255              sshfon(jpind:jpinf), ubtfon(jpind:jpinf), vbtfon(jpind:jpinf), & 
     256              ufon(jpi,jpk), vfon(jpi,jpk), tfon(jpi,jpk),                   & 
     257              sfon(jpi,jpk), vclin(jpi,jpk), sshfon_b(jpind:jpinf,jpj),      & 
     258              !! Arrays for radiative North OBC 
     259              unbnd(jpi,jpk,3,3), vnbnd(jpi,jpk,3,3),                        & 
     260              tnbnd(jpi,jpk,2,2), snbnd(jpi,jpk,2,2),                        & 
     261              u_cynbnd(jpi,jpk), v_cynbnd(jpi,jpk),                          & 
     262              unmsk(jpi,jpk), vnmsk(jpi,jpk), tnmsk (jpi,jpk),               & 
     263              !! South open boundary 
     264              sshfos(jpisd:jpisf), ubtfos(jpisd:jpisf), vbtfos(jpisd:jpisf), & 
     265              ufos(jpi,jpk), vfos(jpi,jpk), tfos(jpi,jpk),                   & 
     266              sfos(jpi,jpk), vclis(jpi,jpk),                                 & 
     267              sshfos_b(jpisd:jpisf,jpj),                                     & 
     268              !! Arrays for radiative South OBC  
     269              usbnd(jpi,jpk,3,3), vsbnd(jpi,jpk,3,3),                        & 
     270              tsbnd(jpi,jpk,2,2), ssbnd(jpi,jpk,2,2),                        & 
     271              u_cysbnd(jpi,jpk), v_cysbnd(jpi,jpk),                          & 
     272              usmsk(jpi,jpk), vsmsk(jpi,jpk), tsmsk(jpi,jpk),                & 
     273              !! 
     274              STAT=obc_oce_alloc ) 
     275      ! 
     276   END FUNCTION obc_oce_alloc 
     277    
     278#else 
     279   !!---------------------------------------------------------------------- 
     280   !!   Default option         Empty module                          No OBC 
     281   !!---------------------------------------------------------------------- 
     282#endif 
     283 
    236284   !!====================================================================== 
    237285END MODULE obc_oce 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90

    r2528 r2715  
    44   !! Open Boundary Cond. :   define related parameters 
    55   !!============================================================================== 
     6   !! history :  OPA  ! 1991-01 (CLIPPER)  Original code  
     7   !!   NEMO     1.0  ! 2002-04   (C. Talandier)  modules 
     8   !!             -   ! 2004/06   (F. Durand) jptobc is defined as a parameter 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_obc 
    711   !!---------------------------------------------------------------------- 
    812   !!   'key_obc' :                                 Open Boundary Condition 
    913   !!---------------------------------------------------------------------- 
    10    !! history : 
    11    !!  8.0   01/91   (CLIPPER)  Original code  
    12    !!  9.0   06/02   (C. Talandier)  modules 
    13    !!        06/04   (F. Durand) ORCA_R2_ZIND config 
    14    !!        06/04   (F. Durand) jptobc is defined as a parameter,  
    15    !!            in order to allow time-dependent OBCs fields on input 
    16    !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1814   USE par_oce         ! ocean parameters 
    1915 
    2016   IMPLICIT NONE 
    2117   PUBLIC 
    22    !!---------------------------------------------------------------------- 
    23    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    24    !! $Id$  
    25    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    26    !!---------------------------------------------------------------------- 
     18 
    2719#if ! defined key_agrif 
    2820   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
    … …  
    4739   !! open boundary parameter 
    4840   !!--------------------------------------------------------------------- 
    49    INTEGER, PARAMETER ::     &  !: time dimension of the BCS fields on input 
    50       jptobc  =         2  
     41   INTEGER, PARAMETER ::   jptobc      =  2        !: time dimension of the BCS fields on input 
     42    
    5143   !! * EAST open boundary 
    52    LOGICAL, PARAMETER ::     &  !: 
    53       lp_obc_east = .FALSE.     !: to active or not the East open boundary 
    54      INTEGER   & 
     44   LOGICAL, PARAMETER ::   lp_obc_east = .FALSE.   !: to active or not the East open boundary 
     45   INTEGER   & 
    5546#if !defined key_agrif 
    5647     , PARAMETER   &  
    … …  
    6455 
    6556   !! * WEST open boundary 
    66    LOGICAL, PARAMETER ::     &  !: 
    67       lp_obc_west = .FALSE.     !: to active or not the West open boundary 
    68      INTEGER   & 
     57   LOGICAL, PARAMETER ::   lp_obc_west = .FALSE.   !: to active or not the West open boundary 
     58   INTEGER   & 
    6959#if !defined key_agrif 
    7060     , PARAMETER   &  
    … …  
    7868 
    7969   !! * NORTH open boundary 
    80    LOGICAL, PARAMETER ::     &  !: 
    81       lp_obc_north = .FALSE.    !: to active or not the North open boundary 
     70   LOGICAL, PARAMETER ::   lp_obc_north = .FALSE.   !: to active or not the North open boundary 
    8271     INTEGER   & 
    8372#if !defined key_agrif 
    … …  
    9281 
    9382   !! * SOUTH open boundary 
    94    LOGICAL, PARAMETER ::     &  !: 
    95       lp_obc_south = .FALSE.    !: to active or not the South open boundary 
     83   LOGICAL, PARAMETER ::   lp_obc_south = .FALSE.   !: to active or not the South open boundary 
    9684     INTEGER   & 
    9785#if !defined key_agrif 
    … …  
    10593      jpisfm1 =  jpisf-1        !: last  ocean point         "                 " 
    10694    
    107    INTEGER, PARAMETER ::     &  !: 
    108       jpnic = 2700              !: maximum number of isolated coastlines points  
     95   INTEGER, PARAMETER ::   jpnic = 2700   !: maximum number of isolated coastlines points  
    10996 
    11097# endif 
    … …  
    117104#endif 
    118105 
     106   !!---------------------------------------------------------------------- 
     107   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     108   !! $Id$  
     109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    119110   !!====================================================================== 
    120111END MODULE obc_par 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2528 r2715  
    44   !! Open boundary data : read the data for the open boundaries. 
    55   !!============================================================================== 
     6   !! History :  OPA  ! 1998-05 (J.M. Molines) Original code 
     7   !!            8.5  ! 2002-10 (C. Talandier, A-M. Treguier) Free surface, F90 
     8   !!   NEMO     1.0  ! 2004-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 
     9   !!            3.0  ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 
     10   !!------------------------------------------------------------------------------ 
    611#if defined key_obc 
    712   !!------------------------------------------------------------------------------ 
    … …  
    1015   !!   obc_dta           : read u, v, t, s data along each open boundary 
    1116   !!------------------------------------------------------------------------------ 
    12    !! * Modules used 
    1317   USE oce             ! ocean dynamics and tracers  
    1418   USE dom_oce         ! ocean space and time domain 
    … …  
    1923   USE in_out_manager  ! I/O logical units 
    2024   USE lib_mpp         ! distributed memory computing 
    21    USE dynspg_oce 
     25   USE dynspg_oce      ! ocean: surface pressure gradient 
    2226   USE ioipsl          ! now only for  ymds2ju function  
    2327   USE iom             !  
    … …  
    2630   PRIVATE 
    2731 
    28    !! * Accessibility 
    29    PUBLIC obc_dta      ! routines called by step.F90 
    30    PUBLIC obc_dta_bt   ! routines called by dynspg_ts.F90 
    31  
    32    !! * Shared module variables 
    33    REAL(wp),  DIMENSION(2)              ::  zjcnes_obc   !  
    34    REAL(wp),  DIMENSION(:), ALLOCATABLE :: ztcobc 
     32   PUBLIC   obc_dta         ! routine  called by step.F90 
     33   PUBLIC   obc_dta_bt      ! routine  called by dynspg_ts.F90 
     34   PUBLIC   obc_dta_alloc   ! function called by obcini.F90 
     35 
     36   REAL(wp),  DIMENSION(2)              ::   zjcnes_obc   !  
     37   REAL(wp),  DIMENSION(:), ALLOCATABLE ::   ztcobc 
    3538   REAL(wp) :: rdt_obc 
    3639   REAL(wp) :: zjcnes 
    … …  
    3942   INTEGER ::  itobce, itobcw, itobcs, itobcn, itobc_b  ! number of time steps in OBC files 
    4043 
    41    INTEGER ::   & 
    42       ntobc      , &     !:  where we are in the obc file 
    43       ntobc_b    , &     !:  first record used 
    44       ntobc_a            !:  second record used 
    45  
    46    CHARACTER (len=40) :: &    ! name of data files 
    47       cl_obc_eTS   , cl_obc_eU,  & 
    48       cl_obc_wTS   , cl_obc_wU,  & 
    49       cl_obc_nTS   , cl_obc_nV,  & 
    50       cl_obc_sTS   , cl_obc_sV 
    51  
    52 # if defined key_dynspg_ts 
     44   INTEGER ::   ntobc        ! where we are in the obc file 
     45   INTEGER ::   ntobc_b      ! first record used 
     46   INTEGER ::   ntobc_a      ! second record used 
     47 
     48   CHARACTER (len=40) ::   cl_obc_eTS, cl_obc_eU   ! name of data files 
     49   CHARACTER (len=40) ::   cl_obc_wTS, cl_obc_wU   !   -       - 
     50   CHARACTER (len=40) ::   cl_obc_nTS, cl_obc_nV   !   -       - 
     51   CHARACTER (len=40) ::   cl_obc_sTS, cl_obc_sV   !   -       - 
     52 
    5353   ! bt arrays for interpolating time dependent data on the boundaries 
    54    INTEGER :: nt_m=0, ntobc_m 
    55    REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtedta, vbtedta, sshedta  ! East 
    56    REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtwdta, vbtwdta, sshwdta ! West 
    57    REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtndta, vbtndta, sshndta ! North 
    58    REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtsdta, vbtsdta, sshsdta ! South 
     54   INTEGER ::   nt_m=0, ntobc_m 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtedta, vbtedta, sshedta    ! East 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtwdta, vbtwdta, sshwdta    ! West 
     57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtndta, vbtndta, sshndta    ! North 
     58   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtsdta, vbtsdta, sshsdta    ! South 
    5959   ! arrays used for interpolating time dependent data on the boundaries 
    60    REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uedta, vedta, tedta, sedta    ! East 
    61    REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uwdta, vwdta, twdta, swdta    ! West 
    62    REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: undta, vndta, tndta, sndta    ! North 
    63    REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: usdta, vsdta, tsdta, ssdta    ! South 
    64 # else 
    65    ! bt arrays for interpolating time dependent data on the boundaries 
    66    REAL(wp), DIMENSION(jpj,jptobc) :: ubtedta, vbtedta, sshedta  ! East 
    67    REAL(wp), DIMENSION(jpj,jptobc) :: ubtwdta, vbtwdta, sshwdta        ! West 
    68    REAL(wp), DIMENSION(jpi,jptobc) :: ubtndta, vbtndta, sshndta        ! North 
    69    REAL(wp), DIMENSION(jpi,jptobc) :: ubtsdta, vbtsdta, sshsdta        ! South 
    70    ! arrays used for interpolating time dependent data on the boundaries 
    71    REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta    ! East 
    72    REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta    ! West 
    73    REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta    ! North 
    74    REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta    ! South 
    75 # endif 
    76    LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE.  ! boolean msks 
    77    LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE.  ! used for outliers 
    78    LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE.  ! checks 
    79    LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta    ! West 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta    ! North 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta    ! South 
     64 
     65   ! Masks set to .TRUE. after successful allocation below 
     66   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltemsk, luemsk, lvemsk  ! boolean msks 
     67   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltwmsk, luwmsk, lvwmsk  ! used for outliers 
     68   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltnmsk, lunmsk, lvnmsk  ! checks 
     69   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltsmsk, lusmsk, lvsmsk 
    8070 
    8171   !! * Substitutions 
    … …  
    8575   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    8676   !! $Id$ 
    87    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     77   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8878   !!---------------------------------------------------------------------- 
    89  
    9079CONTAINS 
     80 
     81   INTEGER FUNCTION obc_dta_alloc() 
     82      !!------------------------------------------------------------------- 
     83      !!                     ***  ROUTINE obc_dta_alloc  *** 
     84      !!------------------------------------------------------------------- 
     85      INTEGER :: ierr(2) 
     86      !!------------------------------------------------------------------- 
     87# if defined key_dynspg_ts 
     88      ALLOCATE(   &     ! time-splitting : 0:jptobc 
     89         ! bt arrays for interpolating time dependent data on the boundaries 
     90         &      ubtedta  (jpj,0:jptobc) , vbtedta  (jpj,0:jptobc) , sshedta  (jpj,0:jptobc) ,    & 
     91         &      ubtwdta  (jpj,0:jptobc) , vbtwdta  (jpj,0:jptobc) , sshwdta  (jpj,0:jptobc) ,    & 
     92         &      ubtndta  (jpi,0:jptobc) , vbtndta  (jpi,0:jptobc) , sshndta  (jpi,0:jptobc) ,    & 
     93         &      ubtsdta  (jpi,0:jptobc) , vbtsdta  (jpi,0:jptobc) , sshsdta  (jpi,0:jptobc) ,    & 
     94         ! arrays used for interpolating time dependent data on the boundaries 
     95         &      uedta(jpj,jpk,0:jptobc) , vedta(jpj,jpk,0:jptobc)                           ,     & 
     96         &      tedta(jpj,jpk,0:jptobc) , sedta(jpj,jpk,0:jptobc)                           ,     & 
     97         &      uwdta(jpj,jpk,0:jptobc) , vwdta(jpj,jpk,0:jptobc)                           ,     & 
     98         &      twdta(jpj,jpk,0:jptobc) , swdta(jpj,jpk,0:jptobc)                           ,     & 
     99         &      undta(jpi,jpk,0:jptobc) , vndta(jpi,jpk,0:jptobc)                           ,     & 
     100         &      tndta(jpi,jpk,0:jptobc) , sndta(jpi,jpk,0:jptobc)                           ,     & 
     101         &      usdta(jpi,jpk,0:jptobc) , vsdta(jpi,jpk,0:jptobc)                           ,     & 
     102         &      tsdta(jpi,jpk,0:jptobc) , ssdta(jpi,jpk,0:jptobc)                           , STAT=ierr(1) ) 
     103# else 
     104      ALLOCATE(   &     ! no time splitting : 1:jptobc 
     105         ! bt arrays for interpolating time dependent data on the boundaries 
     106         &      ubtedta  (jpj,jptobc) , vbtedta  (jpj,jptobc) , sshedta  (jpj,jptobc)  ,     & 
     107         &      ubtwdta  (jpj,jptobc) , vbtwdta  (jpj,jptobc) , sshwdta  (jpj,jptobc)  ,     & 
     108         &      ubtndta  (jpi,jptobc) , vbtndta  (jpi,jptobc) , sshndta  (jpi,jptobc)  ,     & 
     109         &      ubtsdta  (jpi,jptobc) , vbtsdta  (jpi,jptobc) , sshsdta  (jpi,jptobc)  ,     & 
     110         ! arrays used for interpolating time dependent data on the boundaries 
     111         &      uedta(jpj,jpk,jptobc) , vedta(jpj,jpk,jptobc)                          ,     & 
     112         &      tedta(jpj,jpk,jptobc) , sedta(jpj,jpk,jptobc)                          ,     & 
     113         &      uwdta(jpj,jpk,jptobc) , vwdta(jpj,jpk,jptobc)                          ,     & 
     114         &      twdta(jpj,jpk,jptobc) , swdta(jpj,jpk,jptobc)                          ,     & 
     115         &      undta(jpi,jpk,jptobc) , vndta(jpi,jpk,jptobc)                          ,     & 
     116         &      tndta(jpi,jpk,jptobc) , sndta(jpi,jpk,jptobc)                          ,     & 
     117         &      usdta(jpi,jpk,jptobc) , vsdta(jpi,jpk,jptobc)                          ,     & 
     118         &      tsdta(jpi,jpk,jptobc) , ssdta(jpi,jpk,jptobc)                          , STAT=ierr(1) ) 
     119# endif 
     120 
     121      ALLOCATE( ltemsk(jpj,jpk) , luemsk(jpj,jpk) , lvemsk(jpj,jpk) ,     & 
     122         &      ltwmsk(jpj,jpk) , luwmsk(jpj,jpk) , lvwmsk(jpj,jpk) ,     & 
     123         &      ltnmsk(jpj,jpk) , lunmsk(jpj,jpk) , lvnmsk(jpj,jpk) ,     & 
     124         &      ltsmsk(jpj,jpk) , lusmsk(jpj,jpk) , lvsmsk(jpj,jpk) , STAT=ierr(2) ) 
     125 
     126      obc_dta_alloc = MAXVAL( ierr ) 
     127      IF( lk_mpp )   CALL mpp_sum( obc_dta_alloc ) 
     128 
     129      IF( obc_dta_alloc == 0 )  THEN         ! Initialise mask values following successful allocation 
     130         !      east            !          west            !          north           !          south           ! 
     131         ltemsk(:,:) = .TRUE.   ;   ltwmsk(:,:) = .TRUE.   ;   ltnmsk(:,:) = .TRUE.   ;   ltsmsk(:,:) = .TRUE. 
     132         luemsk(:,:) = .TRUE.   ;   luwmsk(:,:) = .TRUE.   ;   lunmsk(:,:) = .TRUE.   ;   lusmsk(:,:) = .TRUE. 
     133         lvemsk(:,:) = .TRUE.   ;   lvwmsk(:,:) = .TRUE.   ;   lvnmsk(:,:) = .TRUE.   ;   lvsmsk(:,:) = .TRUE. 
     134      END IF 
     135      ! 
     136   END FUNCTION obc_dta_alloc 
     137 
    91138 
    92139   SUBROUTINE obc_dta( kt ) 
    … …  
    106153      !!                 attribute of variable time_counter). 
    107154      !! 
    108       !! 
    109       !! History : 
    110       !!        !  98-05 (J.M. Molines) Original code 
    111       !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    112       !! 
    113       !!   9.0  !  04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 
    114       !!        !  2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 
    115155      !!--------------------------------------------------------------------------- 
    116       !! * Arguments 
    117156      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    118  
    119       !! * Local declarations 
     157      ! 
    120158      INTEGER, SAVE :: immfile, iyyfile                     ! 
    121159      INTEGER :: nt              !  record indices (incrementation) 
    122160      REAL(wp) ::   zsec, zxy, znum, zden ! time interpolation weight 
    123  
    124161      !!--------------------------------------------------------------------------- 
    125162 
    … …  
    227264 
    228265 
    229    SUBROUTINE obc_dta_ini (kt) 
     266   SUBROUTINE obc_dta_ini( kt ) 
    230267      !!----------------------------------------------------------------------------- 
    231268      !!                       ***  SUBROUTINE obc_dta_ini  *** 
    232269      !! 
    233       !! ** Purpose : 
    234       !!      When obc_dta first call, realize some data initialization 
    235       !! 
    236       !! ** Method : 
    237       !! 
    238       !! History : 
    239       !!   9.0  ! 07-10 (J.M. Molines ) 
     270      !! ** Purpose :   When obc_dta first call, realize some data initialization 
    240271      !!---------------------------------------------------------------------------- 
    241       !! * Argument 
    242272      INTEGER, INTENT(in)  :: kt      ! ocean time-step index 
    243  
    244       !! * Local declarations 
     273      ! 
    245274      INTEGER ::   ji, jj   ! dummy loop indices 
    246275      INTEGER, SAVE :: immfile, iyyfile                     ! 
    … …  
    521550      !!                Data at the boundary must be in m2/s  
    522551      !! 
    523       !! History : 
    524       !!   9.0  !  05-11 (V. garnier) Original code 
     552      !! History :  9.0  !  05-11 (V. garnier) Original code 
    525553      !!--------------------------------------------------------------------------- 
    526       !! * Arguments 
    527554      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    528555      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index 
    529  
    530       !! * Local declarations 
     556      ! 
    531557      INTEGER ::   ji, jj  ! dummy loop indices 
    532558      INTEGER ::   i15 
    … …  
    534560      REAL(wp) ::  zxy 
    535561      INTEGER ::   isrel           ! number of seconds since 1/1/1992 
    536  
    537562      !!--------------------------------------------------------------------------- 
    538563 
    … …  
    10961121   END SUBROUTINE obc_read 
    10971122 
     1123 
    10981124   INTEGER FUNCTION nrecbef() 
    10991125      !!----------------------------------------------------------------------- 
    … …  
    11271153      END FUNCTION nrecbef 
    11281154 
    1129       !!============================================================================== 
     1155 
    11301156      SUBROUTINE obc_depth_average(nt_x) 
    11311157         !!----------------------------------------------------------------------- 
    … …  
    12121238      END SUBROUTINE obc_dta 
    12131239#endif 
     1240   !!============================================================================== 
    12141241   END MODULE obcdta 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

    r2528 r2715  
    11MODULE obcdyn_bt 
     2   !!====================================================================== 
     3   !!                       ***  MODULE  obcdyn_bt  *** 
     4   !! Ocean dynamics:   Radiation/prescription of sea surface heights on each open boundary 
     5   !!====================================================================== 
     6   !! History :  1.0  ! 2005-12  (V. Garnier) original code 
     7   !!---------------------------------------------------------------------- 
    28#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc 
    3    !!================================================================================= 
    4    !!                       ***  MODULE  obcdyn_bt  *** 
    5    !! Ocean dynamics:   Radiation/prescription of sea surface heights 
    6    !!                   on each open boundary 
    7    !!================================================================================= 
    8  
    9    !!--------------------------------------------------------------------------------- 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_dynspg_ts'     OR                   time spliting free surface 
     11   !!   'key_dynspg_exp'    AND                       explicit free surface 
     12   !!   'key_obc'                                   Open Boundary Condition 
     13   !!---------------------------------------------------------------------- 
    1014   !!   obc_dyn_bt        : call the subroutine for each open boundary 
    1115   !!   obc_dyn_bt_east   : Flather's algorithm at the east open boundary 
    … …  
    1317   !!   obc_dyn_bt_north  : Flather's algorithm at the north open boundary 
    1418   !!   obc_dyn_bt_south  : Flather's algorithm at the south open boundary 
    15    !!---------------------------------------------------------------------------------- 
    16  
    17    !!---------------------------------------------------------------------------------- 
    18    !! * Modules used 
     19   !!---------------------------------------------------------------------- 
    1920   USE oce             ! ocean dynamics and tracers  
    2021   USE dom_oce         ! ocean space and time domain 
    … …  
    3031   PRIVATE 
    3132 
    32    !! * Accessibility 
    33    PUBLIC obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
    34  
    35    !!--------------------------------------------------------------------------------- 
     33   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
     34 
     35   !!---------------------------------------------------------------------- 
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$  
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    39    !!---------------------------------------------------------------------- 
    40  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4140CONTAINS 
    4241 
    43    SUBROUTINE obc_dyn_bt ( kt ) 
    44       !!------------------------------------------------------------------------------ 
    45       !!                      SUBROUTINE obc_dyn_bt 
    46       !!                     *********************** 
    47       !! ** Purpose : 
    48       !!      Apply Flather's algorithm at open boundaries for the explicit 
    49       !!      free surface case and free surface case with time-splitting 
     42   SUBROUTINE obc_dyn_bt( kt ) 
     43      !!---------------------------------------------------------------------- 
     44      !!                 ***  SUBROUTINE obc_dyn_bt  *** 
     45      !! 
     46      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the explicit 
     47      !!              free surface case and free surface case with time-splitting 
    5048      !! 
    5149      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn.  
    … …  
    5553      !!      open one (must be done in the param_obc.h90 file). 
    5654      !! 
    57       !! ** Reference :  
    58       !!         Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
    59       !! 
    60       !! History : 
    61       !!   9.0  !  05-12  (V. Garnier) original  
    62       !!---------------------------------------------------------------------- 
    63       !! * Arguments 
    64       INTEGER, INTENT( in ) ::   kt 
    65  
     55      !! Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
     56      !!---------------------------------------------------------------------- 
     57      INTEGER, INTENT(in) ::   kt 
    6658      !!---------------------------------------------------------------------- 
    6759 
    … …  
    8577 
    8678# if defined key_dynspg_exp 
     79 
    8780   SUBROUTINE obc_dyn_bt_east  
    88       !!------------------------------------------------------------------------------ 
     81      !!---------------------------------------------------------------------- 
    8982      !!                  ***  SUBROUTINE obc_dyn_bt_east  *** 
    9083      !!               
    … …  
    9386      !!      Fix sea surface height (sshn) on east open boundary 
    9487      !!      The logical lfbceast must be .TRUE. 
    95       !! 
    96       !!  History : 
    97       !!   9.0  !  05-12  (V. Garnier) original 
    98       !!------------------------------------------------------------------------------ 
    99       !! * Local declaration 
    100       INTEGER ::   ji, jj, jk ! dummy loop indices 
    101       !!------------------------------------------------------------------------------ 
     88      !!---------------------------------------------------------------------- 
     89      INTEGER, INTENT(in) ::   kt 
     90      !!---------------------------------------------------------------------- 
     91      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     92      !!---------------------------------------------------------------------- 
    10293 
    10394      DO ji = nie0, nie1 
    … …  
    120111 
    121112   SUBROUTINE obc_dyn_bt_west  
    122       !!------------------------------------------------------------------------------ 
     113      !!---------------------------------------------------------------------- 
    123114      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    124115      !!                   
    … …  
    127118      !!      Fix sea surface height (sshn) on west open boundary 
    128119      !!      The logical lfbcwest must be .TRUE. 
    129       !! 
    130       !!  History : 
    131       !!   9.0  !  05-12  (V. Garnier) original 
    132       !!------------------------------------------------------------------------------ 
    133       !! * Local declaration 
    134       INTEGER ::   ji, jj, jk ! dummy loop indices 
    135       !!------------------------------------------------------------------------------ 
    136  
     120      !!---------------------------------------------------------------------- 
     121      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     122      !!---------------------------------------------------------------------- 
     123      ! 
    137124      DO ji = niw0, niw1 
    138125         DO jk = 1, jpkm1 
    … …  
    147134         END DO 
    148135      END DO 
    149  
     136      ! 
    150137   END SUBROUTINE obc_dyn_bt_west 
     138 
    151139 
    152140   SUBROUTINE obc_dyn_bt_north  
    … …  
    158146      !!      Fix sea surface height (sshn) on north open boundary 
    159147      !!      The logical lfbcnorth must be .TRUE. 
    160       !! 
    161       !!  History : 
    162       !!   9.0  !  05-12  (V. Garnier) original 
    163       !!------------------------------------------------------------------------------ 
    164       !! * Local declaration 
    165       INTEGER ::   ji, jj, jk ! dummy loop indices 
    166       !!------------------------------------------------------------------------------ 
    167  
     148      !!---------------------------------------------------------------------- 
     149      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     150      !!---------------------------------------------------------------------- 
     151      ! 
    168152      DO jj = njn0, njn1 
    169153         DO jk = 1, jpkm1 
    … …  
    180164         END DO 
    181165      END DO 
    182  
     166      ! 
    183167   END SUBROUTINE obc_dyn_bt_north 
    184168 
     169 
    185170   SUBROUTINE obc_dyn_bt_south  
    186       !!------------------------------------------------------------------------------ 
     171      !!---------------------------------------------------------------------- 
    187172      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
    188173      !!                     
    … …  
    191176      !!      Fix sea surface height (sshn) on south open boundary 
    192177      !!      The logical lfbcsouth must be .TRUE. 
    193       !! 
    194       !!  History : 
    195       !!   9.0  !  05-12  (V. Garnier) original 
    196       !!------------------------------------------------------------------------------ 
    197       !! * Local declaration 
    198       INTEGER ::   ji, jj, jk ! dummy loop indices 
    199  
    200       !!------------------------------------------------------------------------------ 
    201  
     178      !!---------------------------------------------------------------------- 
     179      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     180      !!---------------------------------------------------------------------- 
     181      ! 
    202182      DO jj = njs0, njs1 
    203183         DO jk = 1, jpkm1 
    … …  
    212192         END DO 
    213193      END DO 
    214  
     194      ! 
    215195   END SUBROUTINE obc_dyn_bt_south 
    216196 
    … …  
    225205      !!      Fix sea surface height (sshn) on east open boundary 
    226206      !!      The logical lfbceast must be .TRUE. 
    227       !! 
    228       !!  History : 
    229       !!   9.0  !  05-12  (V. Garnier) original 
    230       !!------------------------------------------------------------------------------ 
    231       !! * Local declaration 
    232       INTEGER ::   ji, jj, jk ! dummy loop indices 
    233       !!------------------------------------------------------------------------------ 
    234  
     207      !!---------------------------------------------------------------------- 
     208      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     209      !!---------------------------------------------------------------------- 
     210      ! 
    235211      DO ji = nie0, nie1 
    236212         DO jk = 1, jpkm1 
    … …  
    245221         END DO 
    246222      END DO 
    247  
     223      ! 
    248224   END SUBROUTINE obc_dyn_bt_east 
    249225 
     226 
    250227   SUBROUTINE obc_dyn_bt_west  
    251       !!------------------------------------------------------------------------------ 
     228      !!--------------------------------------------------------------------- 
    252229      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    253230      !! 
    254       !! ** Purpose : 
    255       !! ** Purpose : 
    256       !!      Apply Flather algorithm on west OBC velocities ua, va 
     231      !! ** Purpose :   Apply Flather algorithm on west OBC velocities ua, va 
    257232      !!      Fix sea surface height (sshn) on west open boundary 
    258233      !!      The logical lfbcwest must be .TRUE. 
    259       !! 
    260       !!  History : 
    261       !!   9.0  !  05-12  (V. Garnier) original 
    262       !!------------------------------------------------------------------------------ 
    263       !! * Local declaration 
    264       INTEGER ::   ji, jj, jk ! dummy loop indices 
    265       !!------------------------------------------------------------------------------ 
    266  
     234      !!---------------------------------------------------------------------- 
     235      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     236      !!---------------------------------------------------------------------- 
     237      ! 
    267238      DO ji = niw0, niw1 
    268239         DO jk = 1, jpkm1 
    … …  
    275246         END DO 
    276247      END DO 
    277  
     248      ! 
    278249   END SUBROUTINE obc_dyn_bt_west 
     250 
    279251 
    280252   SUBROUTINE obc_dyn_bt_north  
    281253      !!------------------------------------------------------------------------------ 
    282       !!                     SUBROUTINE obc_dyn_bt_north 
    283       !!                    ************************* 
     254      !!                ***  SUBROUTINE obc_dyn_bt_north  *** 
     255      !!                 
    284256      !! ** Purpose : 
    285257      !!      Apply Flather algorithm on north OBC velocities ua, va 
    286258      !!      Fix sea surface height (sshn) on north open boundary 
    287259      !!      The logical lfbcnorth must be .TRUE. 
    288       !! 
    289       !!  History : 
    290       !!   9.0  !  05-12  (V. Garnier) original 
    291       !!------------------------------------------------------------------------------ 
    292       !! * Local declaration 
    293       INTEGER ::   ji, jj, jk ! dummy loop indices 
    294       !!------------------------------------------------------------------------------ 
    295  
     260      !!---------------------------------------------------------------------- 
     261      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     262      !!---------------------------------------------------------------------- 
     263      ! 
    296264      DO jj = njn0, njn1 
    297265         DO jk = 1, jpkm1 
    … …  
    306274         END DO 
    307275      END DO 
    308  
     276      ! 
    309277   END SUBROUTINE obc_dyn_bt_north 
     278 
    310279 
    311280   SUBROUTINE obc_dyn_bt_south  
    312281      !!------------------------------------------------------------------------------ 
    313       !!                     SUBROUTINE obc_dyn_bt_south 
    314       !!                    ************************* 
     282      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
     283      !!                   
    315284      !! ** Purpose : 
    316285      !!      Apply Flather algorithm on south OBC velocities ua, va 
    317286      !!      Fix sea surface height (sshn) on south open boundary 
    318287      !!      The logical lfbcsouth must be .TRUE. 
    319       !! 
    320       !!  History : 
    321       !!   9.0  !  05-12  (V. Garnier) original 
    322       !!------------------------------------------------------------------------------ 
    323       !! * Local declaration 
    324       INTEGER ::   ji, jj, jk ! dummy loop indices 
    325  
    326       !!------------------------------------------------------------------------------ 
    327  
     288      !!---------------------------------------------------------------------- 
     289      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     290      !!---------------------------------------------------------------------- 
     291      ! 
    328292      DO jj = njs0, njs1 
    329293         DO jk = 1, jpkm1 
    … …  
    336300         END DO 
    337301      END DO 
    338  
     302      ! 
    339303   END SUBROUTINE obc_dyn_bt_south 
    340304 
    341305# endif 
     306 
    342307#else 
    343    !!================================================================================= 
    344    !!                       ***  MODULE  obcdyn_bt  *** 
    345    !! Ocean dynamics:   Radiation of velocities on each open boundary 
    346    !!================================================================================= 
     308   !!---------------------------------------------------------------------- 
     309   !!   Default option       No Open Boundaries or not explicit fre surface 
     310   !!---------------------------------------------------------------------- 
    347311CONTAINS 
    348  
    349    SUBROUTINE obc_dyn_bt 
    350                               ! No open boundaries ==> empty routine 
     312   SUBROUTINE obc_dyn_bt      ! Dummy routine 
    351313   END SUBROUTINE obc_dyn_bt 
    352314#endif 
    353315 
     316   !!====================================================================== 
    354317END MODULE obcdyn_bt 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90

    r2528 r2715  
    55   !!====================================================================== 
    66   !! History :  2.0  ! 2005-12  (V. Garnier) original code 
    7    !!            3.3  ! 2010-11  (G. Madec) 
     7   !!            3.3  ! 2010-11  (G. Madec)  
     8   !!            4.0  ! 2011-02  (G. Madec) velocity & ssh passed in argument 
    89   !!---------------------------------------------------------------------- 
    9 #if defined key_obc && defined key_dynspg_ts 
     10#if defined key_obc   &&  defined key_dynspg_ts 
    1011   !!---------------------------------------------------------------------- 
    1112   !!   'key_obc'          and                      Open Boundary Condition 
    … …  
    3132 
    3233   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     34   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3435   !! $Id$ 
    3536   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3738CONTAINS 
    3839 
    39    SUBROUTINE obc_fla_ts 
     40   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                      SUBROUTINE obc_fla_ts 
    … …  
    5253      !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
    5354      !!---------------------------------------------------------------------- 
     55      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities 
     56      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
     57      !!---------------------------------------------------------------------- 
    5458      ! 
    55       IF( lp_obc_east  )   CALL obc_fla_ts_east  
    56       IF( lp_obc_west  )   CALL obc_fla_ts_west  
    57       IF( lp_obc_north )   CALL obc_fla_ts_north 
    58       IF( lp_obc_south )   CALL obc_fla_ts_south 
     59      IF( lp_obc_east  )   CALL obc_fla_ts_east ( pua, pva, p_sshn, p_ssha )  
     60      IF( lp_obc_west  )   CALL obc_fla_ts_west ( pua, pva, p_sshn, p_ssha ) 
     61      IF( lp_obc_north )   CALL obc_fla_ts_north( pua, pva, p_sshn, p_ssha ) 
     62      IF( lp_obc_south )   CALL obc_fla_ts_south( pua, pva, p_sshn, p_ssha )  
    5963      ! 
    6064   END SUBROUTINE obc_fla_ts 
    6165 
    6266 
    63    SUBROUTINE obc_fla_ts_east 
     67   SUBROUTINE obc_fla_ts_east( pua, pva, p_sshn, p_ssha )  
    6468      !!---------------------------------------------------------------------- 
    6569      !!                  ***  SUBROUTINE obc_fla_ts_east  *** 
    6670      !! 
    6771      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va 
    68       !!              Fix sea surface height (sshn_e) on east open boundary 
     72      !!              Fix sea surface height (p_sshn) on east open boundary 
    6973      !!---------------------------------------------------------------------- 
    70       INTEGER ::   ji, jj ! dummy loop indices 
     74      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities 
     75      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
     76      ! 
     77      INTEGER ::   ji, jj   ! dummy loop indices 
    7178      !!---------------------------------------------------------------------- 
    7279      ! 
    7380      DO ji = nie0, nie1 
    7481         DO jj = 1, jpj 
    75             ua_e    (ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + SQRT( grav*hur(ji,jj) )          & 
    76                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 - sshfoe(jj) )  ) * uemsk(jj,1) 
     82            pua     (ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + SQRT( grav*hur(ji,jj) )          & 
     83               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )  ) * uemsk(jj,1) 
    7784            sshfoe_b(ji,jj) =    sshfoe_b(ji,jj)         + SQRT( grav*hur(ji,jj) )          & 
    78                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 - sshfoe(jj) )    * uemsk(jj,1) 
     85               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )    * uemsk(jj,1) 
    7986         END DO 
    8087      END DO 
    8188      DO ji = nie0p1, nie1p1 
    8289         DO jj = 1, jpj 
    83             ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) + temsk(jj,1) * sshfoe(jj) 
    84             va_e  (ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1) 
     90            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - temsk(jj,1) ) + temsk(jj,1) * sshfoe(jj) 
     91            pva   (ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1) 
    8592         END DO 
    8693      END DO 
    … …  
    8996 
    9097 
    91    SUBROUTINE obc_fla_ts_west 
     98   SUBROUTINE obc_fla_ts_west( pua, pva, p_sshn, p_ssha ) 
    9299      !!---------------------------------------------------------------------- 
    93100      !!                  ***  SUBROUTINE obc_fla_ts_west  *** 
    94101      !!  
    95102      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va 
    96       !!              Fix sea surface height (sshn_e) on west open boundary 
     103      !!              Fix sea surface height (p_sshn) on west open boundary 
    97104      !!---------------------------------------------------------------------- 
    98       INTEGER ::   ji, jj ! dummy loop indices 
     105      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities 
     106      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
     107      ! 
     108      INTEGER ::   ji, jj   ! dummy loop indices 
    99109      !!---------------------------------------------------------------------- 
    100110      ! 
    101111      DO ji = niw0, niw1 
    102112         DO jj = 1, jpj 
    103             ua_e    (ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )            & 
    104                &                * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 - sshfow(jj) ) ) * uwmsk(jj,1) 
    105             va_e    (ji,jj) =   vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1) 
     113            pua     (ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )            & 
     114               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) ) ) * uwmsk(jj,1) 
     115            pva     (ji,jj) =   vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1) 
    106116            sshfow_b(ji,jj) =   sshfow_b(ji,jj) - SQRT( grav * hur(ji,jj) )                    & 
    107                &                * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 - sshfow(jj) )   * uwmsk(jj,1) 
    108             ssha_e  (ji,jj) = ssha_e(ji,jj) * ( 1. - twmsk(jj,1) ) + twmsk(jj,1)*sshfow(jj) 
     117               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) )   * uwmsk(jj,1) 
     118            p_ssha  (ji,jj) = p_ssha(ji,jj) * ( 1. - twmsk(jj,1) ) + twmsk(jj,1)*sshfow(jj) 
    109119         END DO 
    110120      END DO 
    … …  
    113123 
    114124 
    115    SUBROUTINE obc_fla_ts_north 
     125   SUBROUTINE obc_fla_ts_north( pua, pva, p_sshn, p_ssha ) 
    116126      !!---------------------------------------------------------------------- 
    117127      !!                     SUBROUTINE obc_fla_ts_north 
    118128      !! 
    119129      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va 
    120       !!              Fix sea surface height (sshn_e) on north open boundary 
     130      !!              Fix sea surface height (p_sshn) on north open boundary 
    121131      !!---------------------------------------------------------------------- 
    122       INTEGER ::   ji, jj ! dummy loop indices 
     132      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities 
     133      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
     134      ! 
     135      INTEGER ::   ji, jj   ! dummy loop indices 
    123136      !!---------------------------------------------------------------------- 
    124137      ! 
    125138      DO jj = njn0, njn1 
    126139         DO ji = 1, jpi 
    127             va_e    (ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )            & 
    128                &                * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 - sshfon(ji) ) ) * vnmsk(ji,1) 
     140            pva     (ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )            & 
     141               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) ) ) * vnmsk(ji,1) 
    129142            sshfon_b(ji,jj) =   sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )                    & 
    130                &                * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 - sshfon(ji) )   * vnmsk(ji,1) 
     143               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) )   * vnmsk(ji,1) 
    131144         END DO 
    132145      END DO 
    133146      DO jj = njn0p1, njn1p1 
    134147         DO ji = 1, jpi 
    135             ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) + sshfon(ji) * tnmsk(ji,1) 
    136             ua_e  (ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1) 
     148            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - tnmsk(ji,1) ) + sshfon(ji) * tnmsk(ji,1) 
     149            pua   (ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1) 
    137150         END DO 
    138151      END DO 
    … …  
    141154 
    142155 
    143    SUBROUTINE obc_fla_ts_south 
     156   SUBROUTINE obc_fla_ts_south( pua, pva, p_sshn, p_ssha ) 
    144157      !!---------------------------------------------------------------------- 
    145158      !!                     SUBROUTINE obc_fla_ts_south 
    146159      !! 
    147160      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va 
    148       !!              Fix sea surface height (sshn_e) on south open boundary 
     161      !!              Fix sea surface height (p_sshn) on south open boundary 
    149162      !!---------------------------------------------------------------------- 
    150       INTEGER ::   ji, jj ! dummy loop indices 
     163      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities 
     164      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
     165      ! 
     166      INTEGER ::   ji, jj   ! dummy loop indices 
    151167      !!---------------------------------------------------------------------- 
    152168      ! 
    153169      DO jj = njs0, njs1 
    154170         DO ji = 1, jpi 
    155             va_e    (ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )            & 
    156                &                * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 - sshfos(ji) ) ) * vsmsk(ji,1) 
    157             ua_e    (ji,jj) =   ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1) 
     171            pva     (ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )            & 
     172               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) ) ) * vsmsk(ji,1) 
     173            pua     (ji,jj) =   ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1) 
    158174            sshfos_b(ji,jj) =   sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )                    & 
    159                &                * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 - sshfos(ji) )   * vsmsk(ji,1) 
    160             ssha_e  (ji,jj) = ssha_e(ji,jj) * (1. - tsmsk(ji,1) ) + tsmsk(ji,1) * sshfos(ji) 
     175               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) )   * vsmsk(ji,1) 
     176            p_ssha  (ji,jj) = p_ssha(ji,jj) * (1. - tsmsk(ji,1) ) + tsmsk(ji,1) * sshfos(ji) 
    161177         END DO 
    162178      END DO 
    … …  
    169185   !!---------------------------------------------------------------------- 
    170186CONTAINS 
    171  
    172    SUBROUTINE obc_fla_ts 
    173       WRITE(*,*) 'obc_fla_ts: You should not have seen this print! error?' 
     187   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 
     188      REAL, DIMENSION(:,:)::   pua, pva, p_sshn, p_ssha 
     189      WRITE(*,*) 'obc_fla_ts: You should not have seen this print! error?', pua(1,1), pva(1,1), p_sshn(1,1), p_ssha(1,1) 
    174190   END SUBROUTINE obc_fla_ts 
    175191#endif 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90

    r2565 r2715  
    1818   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1919   USE phycst          ! physical constants 
    20    USE obc_oce         ! ocean open boundary conditions 
    21    USE lib_mpp         ! for mpp_sum 
     20   USE obc_oce         ! open boundary condition: ocean 
     21   USE obcdta          ! open boundary condition: data 
    2222   USE in_out_manager  ! I/O units 
     23   USE lib_mpp         ! MPP library 
    2324   USE dynspg_oce      ! flag lk_dynspg_flt 
    2425 
    … …  
    3334   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3435   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3637   !!---------------------------------------------------------------------- 
    37  
    3838CONTAINS 
    3939    
    … …  
    8181      rdpnob   = rn_dpnob 
    8282      volemp   = rn_volemp 
    83        
    84  
     83 
     84      !                              ! allocate obc arrays 
     85      IF( obc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_oce arrays' ) 
     86      IF( obc_dta_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_dta arrays' ) 
    8587 
    8688      ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90

    r2528 r2715  
    1212   !!   obc_rad_south  : compute the south phase velocities 
    1313   !!--------------------------------------------------------------------------------- 
    14    !! * Modules used 
    1514   USE oce             ! ocean dynamics and tracers variables 
    1615   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2423   PRIVATE 
    2524 
    26    !! * Accessibility 
    27    PUBLIC obc_rad        ! routine called by step.F90 
    28  
    29    !! * Module variables 
     25   PUBLIC   obc_rad    ! routine called by step.F90 
     26 
    3027   INTEGER ::   ji, jj, jk     ! dummy loop indices 
    3128 
    … …  
    6966      !!                                                 J. Molines and G. Madec version 
    7067      !!------------------------------------------------------------------------------ 
    71       !! * Arguments 
    7268      INTEGER, INTENT( in ) ::   kt 
    7369      !!---------------------------------------------------------------------- 
    … …  
    143139            END DO 
    144140         END DO 
    145          IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
     141         IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj, numout ) 
    146142 
    147143         ! ... extremeties nie0, nie1 
    … …  
    185181            END DO 
    186182         END DO 
    187          IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
     183         IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 
    188184 
    189185         !... extremeties nie0, nie1 
    … …  
    226222            END DO 
    227223         END DO 
    228          IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    229          IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     224         IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
     225         IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    230226 
    231227         ! ... extremeties nie0, nie1 
    … …  
    327323            END DO 
    328324         END DO 
    329          IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 
     325         IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj, numout ) 
    330326 
    331327         ! ... extremeties nie0, nie1 
    … …  
    409405            END DO 
    410406         END DO 
    411          IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     407         IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    412408 
    413409         ! ... extremeties niw0, niw1 
    … …  
    451447            END DO 
    452448         END DO 
    453          IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
     449         IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    454450 
    455451         ! ... extremeties niw0, niw1  
    … …  
    492488            END DO 
    493489         END DO 
    494          IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    495          IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     490         IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
     491         IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    496492 
    497493         ! ... extremeties niw0, niw1 
    … …  
    596592            END DO 
    597593         END DO 
    598          IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 
     594         IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj, numout ) 
    599595 
    600596         ! ... extremeties niw0, niw1 
    … …  
    673669            END DO 
    674670         END DO 
    675          IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
     671         IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 
    676672 
    677673         ! ... extremeties njn0,njn1  
    … …  
    720716            END DO 
    721717         END DO 
    722          IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 
     718         IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi, numout ) 
    723719 
    724720         ! ... extremeties njn0,njn1 
    … …  
    761757            END DO 
    762758         END DO 
    763          IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    764          IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     759         IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
     760         IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    765761 
    766762         ! ... extremeties  njn0,njn1 
    … …  
    828824            END DO 
    829825         END DO 
    830          IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 
     826         IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi, numout ) 
    831827 
    832828         ! ... extremeties  njn0,njn1 
    … …  
    947943            END DO 
    948944         END DO 
    949          IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     945         IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    950946 
    951947         ! ... extremeties njs0,njs1 
    … …  
    992988            END DO 
    993989         END DO 
    994          IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
     990         IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    995991 
    996992         ! ... extremeties njs0,njs1 
    … …  
    10331029            END DO 
    10341030         END DO 
    1035          IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    1036          IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     1031         IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
     1032         IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    10371033 
    10381034         ! ... extremeties  njs0,njs1 
    … …  
    11001096            END DO 
    11011097         END DO 
    1102          IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 
     1098         IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi, numout ) 
    11031099 
    11041100         ! ... extremeties  njs0,njs1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90

    r2528 r2715  
    77 
    88   !!--------------------------------------------------------------------------------- 
    9    !! * Modules used 
    109   USE oce             ! ocean dynamics and tracers variables 
    1110   USE dom_oce         ! ocean space and time domain variables 
    … …  
    1918   PRIVATE 
    2019 
    21    !! * Accessibility 
    22    PUBLIC obc_rst_read       ! routine called by obc_ini 
    23    PUBLIC obc_rst_write      ! routine called by step 
    24  
    25    !!--------------------------------------------------------------------------------- 
     20   PUBLIC   obc_rst_read    ! routine called by obc_ini 
     21   PUBLIC   obc_rst_write   ! routine called by step 
     22 
     23   !!---------------------------------------------------------------------- 
    2624   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    2725   !! $Id$  
    28    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    29    !!--------------------------------------------------------------------------------- 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    3028 
    3129CONTAINS 
    … …  
    565563      IF( lk_mpp ) THEN 
    566564         IF( lp_obc_east ) THEN 
    567             CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 
    568             CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 
    569             CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
    570             CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 
     565            CALL mppobc(uebnd,jpjed,jpjef,jpieob  ,jpk*3*3,2,jpj, numout ) 
     566            CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 
     567            CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
     568            CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    571569         ENDIF 
    572570         IF( lp_obc_west ) THEN 
    573             CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    574             CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 
    575             CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
    576             CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 
     571            CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
     572            CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
     573            CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
     574            CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    577575         ENDIF 
    578576         IF( lp_obc_north ) THEN  
    579             CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 
    580             CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi) 
    581             CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
    582             CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 
     577            CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 
     578            CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi, numout ) 
     579            CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
     580            CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    583581         ENDIF 
    584582         IF( lp_obc_south ) THEN 
    585             CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    586             CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 
    587             CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
    588             CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 
     583            CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
     584            CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
     585            CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
     586            CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    589587         ENDIF 
    590588      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.