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 2479 – NEMO

Changeset 2479


Ignore:
Timestamp:
2010-12-17T16:21:13+01:00 (14 years ago)
Author:
cetlod
Message:

v3.2:correct compilation error in obc, see ticket #548

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r2374 r2479  
    11MODULE obcfla 
    2 #if defined key_obc && defined key_dynspg_ts 
    3    !!================================================================================= 
     2   !!====================================================================== 
    43   !!                       ***  MODULE  obcfla  *** 
    54   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting 
    6    !!================================================================================= 
    7  
    8    !!--------------------------------------------------------------------------------- 
     5   !!====================================================================== 
     6   !! History :  2.0  ! 2005-12  (V. Garnier) original code 
     7   !!            3.3  ! 2010-11  (G. Madec) 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_obc && defined key_dynspg_ts 
     10   !!---------------------------------------------------------------------- 
     11   !!   'key_obc'          and                      Open Boundary Condition 
     12   !!   'key_dynspg_ts'                    free surface with time splitting 
     13   !!---------------------------------------------------------------------- 
    914   !!   obc_fla_ts        : call the subroutine for each open boundary 
    1015   !!   obc_fla_ts_east   : Flather on the east  open boundary velocities & ssh 
    … …  
    1217   !!   obc_fla_ts_north  : Flather on the north open boundary velocities & ssh 
    1318   !!   obc_fla_ts_south  : Flather on the south open boundary velocities & ssh 
    14    !!---------------------------------------------------------------------------------- 
    15  
    16    !!---------------------------------------------------------------------------------- 
    17    !! * Modules used 
     19   !!---------------------------------------------------------------------- 
    1820   USE oce             ! ocean dynamics and tracers  
    1921   USE dom_oce         ! ocean space and time domain 
    … …  
    2628   PRIVATE 
    2729 
    28    !! * Accessibility 
    29    PUBLIC obc_fla_ts  ! routine called in dynspg_ts (free surface time splitting case) 
     30   PUBLIC   obc_fla_ts   ! routine called in dynspg_ts (free surface time splitting case) 
    3031 
    31    !!--------------------------------------------------------------------------------- 
    32    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3334   !! $Id$ 
    34    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    35    !!--------------------------------------------------------------------------------- 
    36  
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3737CONTAINS 
    3838 
    3939   SUBROUTINE obc_fla_ts 
    40       !!------------------------------------------------------------------------------ 
     40      !!---------------------------------------------------------------------- 
    4141      !!                      SUBROUTINE obc_fla_ts 
    42       !!                     ********************** 
    43       !! ** Purpose : 
    44       !!      Apply Flather's algorithm at open boundaries for the time-splitting 
    45       !!      free surface case (barotropic variables) 
     42      !! 
     43      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the  
     44      !!      time-splitting free surface case (barotropic variables) 
    4645      !! 
    4746      !!      This routine is called in dynspg_ts.F90 routine  
    … …  
    5150      !!      open one (must be done in the obc_par.F90 file). 
    5251      !! 
    53       !! ** Reference : 
    54       !!         Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
    55       !! 
    56       !! History : 
    57       !!   9.0  !  05-12  (V. Garnier) original 
    58       !!------------------------------------------------------------------------------ 
    59  
     52      !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
     53      !!---------------------------------------------------------------------- 
     54      ! 
    6055      IF( lp_obc_east  )   CALL obc_fla_ts_east  
    6156      IF( lp_obc_west  )   CALL obc_fla_ts_west  
    6257      IF( lp_obc_north )   CALL obc_fla_ts_north 
    6358      IF( lp_obc_south )   CALL obc_fla_ts_south 
    64  
     59      ! 
    6560   END SUBROUTINE obc_fla_ts 
    6661 
    6762 
    6863   SUBROUTINE obc_fla_ts_east 
    69       !!------------------------------------------------------------------------------ 
     64      !!---------------------------------------------------------------------- 
    7065      !!                  ***  SUBROUTINE obc_fla_ts_east  *** 
    7166      !! 
    72       !! ** Purpose : 
    73       !!      Apply Flather's algorithm on east OBC velocities ua, va 
    74       !!      Fix sea surface height (sshn_e) on east open boundary 
    75       !! 
    76       !!  History : 
    77       !!   9.0  !  05-12  (V. Garnier) original 
    78       !!------------------------------------------------------------------------------ 
    79       !! * Local declaration 
     67      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va 
     68      !!              Fix sea surface height (sshn_e) on east open boundary 
     69      !!---------------------------------------------------------------------- 
    8070      INTEGER ::   ji, jj ! dummy loop indices 
    81       !!------------------------------------------------------------------------------ 
    82  
     71      !!---------------------------------------------------------------------- 
     72      ! 
    8373      DO ji = nie0, nie1 
    8474         DO jj = 1, jpj 
    85             ua_e(ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + sqrt( grav*hur(ji,jj) )   & 
    86                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5        & 
    87                &            - sshfoe(jj) )  ) * uemsk(jj,1) 
    88             sshfoe_b(ji,jj) = sshfoe_b(ji,jj) + sqrt( grav*hur(ji,jj) )     & 
    89                &             * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  & 
    90                &            - sshfoe(jj) )  ) * uemsk(jj,1) 
     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) 
     77            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) 
    9179         END DO 
    9280      END DO 
    9381      DO ji = nie0p1, nie1p1 
    9482         DO jj = 1, jpj 
    95             ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) & 
    96                &            + temsk(jj,1) * sshfoe(jj) 
    97             va_e(ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1) 
     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) 
    9885         END DO 
    9986      END DO 
    100  
     87      ! 
    10188   END SUBROUTINE obc_fla_ts_east 
    10289 
    10390 
    10491   SUBROUTINE obc_fla_ts_west 
    105       !!------------------------------------------------------------------------------ 
     92      !!---------------------------------------------------------------------- 
    10693      !!                  ***  SUBROUTINE obc_fla_ts_west  *** 
    10794      !!  
    108       !! ** Purpose : 
    109       !!      Apply Flather's algorithm on west OBC velocities ua, va 
    110       !!      Fix sea surface height (sshn_e) on west open boundary 
    111       !! 
    112       !!  History : 
    113       !!   9.0  !  05-12  (V. Garnier) original 
    114       !!------------------------------------------------------------------------------ 
    115       !! * Local declaration 
     95      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va 
     96      !!              Fix sea surface height (sshn_e) on west open boundary 
     97      !!---------------------------------------------------------------------- 
    11698      INTEGER ::   ji, jj ! dummy loop indices 
    117       !!------------------------------------------------------------------------------ 
    118  
     99      !!---------------------------------------------------------------------- 
     100      ! 
    119101      DO ji = niw0, niw1 
    120102         DO jj = 1, jpj 
    121             ua_e(ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )   & 
    122                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5         & 
    123                &                - sshfow(jj) ) ) * uwmsk(jj,1) 
    124             va_e(ji,jj) = vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1) 
    125          END DO 
    126          DO jj = 1, jpj 
    127             sshfow_b(ji,jj) = sshfow_b(ji,jj) - sqrt( grav * hur(ji,jj) )     & 
    128                               * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5   & 
    129                                  - sshfow(jj) ) * uwmsk(jj,1) 
    130             ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - twmsk(jj,1) ) & 
    131                &            + twmsk(jj,1)*sshfow(jj) 
     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) 
     106            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) 
    132109         END DO 
    133110      END DO 
    134  
     111      ! 
    135112   END SUBROUTINE obc_fla_ts_west 
    136113 
     114 
    137115   SUBROUTINE obc_fla_ts_north 
    138       !!------------------------------------------------------------------------------ 
     116      !!---------------------------------------------------------------------- 
    139117      !!                     SUBROUTINE obc_fla_ts_north 
    140       !!                    ************************* 
    141       !! ** Purpose : 
    142       !!      Apply Flather's algorithm on north OBC velocities ua, va 
    143       !!      Fix sea surface height (sshn_e) on north open boundary 
    144118      !! 
    145       !!  History : 
    146       !!   9.0  !  05-12  (V. Garnier) original 
    147       !!------------------------------------------------------------------------------ 
    148       !! * Local declaration 
     119      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va 
     120      !!              Fix sea surface height (sshn_e) on north open boundary 
     121      !!---------------------------------------------------------------------- 
    149122      INTEGER ::   ji, jj ! dummy loop indices 
    150       !!------------------------------------------------------------------------------ 
    151  
     123      !!---------------------------------------------------------------------- 
     124      ! 
    152125      DO jj = njn0, njn1 
    153126         DO ji = 1, jpi 
    154             va_e(ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )   & 
    155                &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
    156                &                - sshfon(ji) ) ) * vnmsk(ji,1) 
    157             sshfon_b(ji,jj) = sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )  & 
    158                &              * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    & 
    159                &                  - sshfon(ji) ) * vnmsk(ji,1) 
     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) 
     129            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) 
    160131         END DO 
    161132      END DO 
    162133      DO jj = njn0p1, njn1p1 
    163134         DO ji = 1, jpi 
    164             ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) & 
    165                &            + sshfon(ji) * tnmsk(ji,1) 
    166             ua_e(ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1) 
     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) 
    167137         END DO 
    168138      END DO 
    169  
     139      ! 
    170140   END SUBROUTINE obc_fla_ts_north 
    171141 
     142 
    172143   SUBROUTINE obc_fla_ts_south 
    173       !!------------------------------------------------------------------------------ 
     144      !!---------------------------------------------------------------------- 
    174145      !!                     SUBROUTINE obc_fla_ts_south 
    175       !!                    ************************* 
    176       !! ** Purpose : 
    177       !!      Apply Flather's algorithm on south OBC velocities ua, va 
    178       !!      Fix sea surface height (sshn_e) on south open boundary 
    179146      !! 
    180       !!  History : 
    181       !!   9.0  !  05-12  (V. Garnier) original 
    182       !!------------------------------------------------------------------------------ 
    183       !! * Local declaration 
     147      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va 
     148      !!              Fix sea surface height (sshn_e) on south open boundary 
     149      !!---------------------------------------------------------------------- 
    184150      INTEGER ::   ji, jj ! dummy loop indices 
    185  
    186       !!------------------------------------------------------------------------------ 
    187  
     151      !!---------------------------------------------------------------------- 
     152      ! 
    188153      DO jj = njs0, njs1 
    189154         DO ji = 1, jpi 
    190             va_e(ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )   & 
    191                &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
    192                &                - sshfos(ji) ) ) * vsmsk(ji,1) 
    193             ua_e(ji,jj) = ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1) 
    194          END DO 
    195          DO ji = 1, jpi 
    196             sshfos_b(ji,jj) = sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )      & 
    197                &              * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    & 
    198                &                  - sshfos(ji) ) * vsmsk(ji,1) 
    199             ssha_e(ji,jj) = ssha_e(ji,jj) * (1. - tsmsk(ji,1) ) & 
    200                &            + tsmsk(ji,1) * sshfos(ji) 
     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) 
     158            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) 
    201161         END DO 
    202162      END DO 
    203  
     163      ! 
    204164   END SUBROUTINE obc_fla_ts_south 
     165    
    205166#else 
    206    !!================================================================================= 
    207    !!                       ***  MODULE  obcfla  *** 
    208    !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting 
    209    !!================================================================================= 
     167   !!---------------------------------------------------------------------- 
     168   !!   Dummy module :                             No OBC or time-splitting 
     169   !!---------------------------------------------------------------------- 
    210170CONTAINS 
    211171 
    … …  
    214174   END SUBROUTINE obc_fla_ts 
    215175#endif 
    216  
     176   !!====================================================================== 
    217177END MODULE obcfla 
Note: See TracChangeset for help on using the changeset viewer.