- Timestamp:
- 2010-12-17T16:21:13+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/OBC/obcfla.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obcfla.F90
r2374 r2479 1 1 MODULE obcfla 2 #if defined key_obc && defined key_dynspg_ts 3 !!================================================================================= 2 !!====================================================================== 4 3 !! *** MODULE obcfla *** 5 4 !! 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 !!---------------------------------------------------------------------- 9 14 !! obc_fla_ts : call the subroutine for each open boundary 10 15 !! obc_fla_ts_east : Flather on the east open boundary velocities & ssh … … 12 17 !! obc_fla_ts_north : Flather on the north open boundary velocities & ssh 13 18 !! obc_fla_ts_south : Flather on the south open boundary velocities & ssh 14 !!---------------------------------------------------------------------------------- 15 16 !!---------------------------------------------------------------------------------- 17 !! * Modules used 19 !!---------------------------------------------------------------------- 18 20 USE oce ! ocean dynamics and tracers 19 21 USE dom_oce ! ocean space and time domain … … 26 28 PRIVATE 27 29 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) 30 31 31 !!---------------------------------------------------------------------- -----------32 !! OPA 9.0 , LOCEAN-IPSL (2005)32 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 34 !! $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 !!---------------------------------------------------------------------- 37 37 CONTAINS 38 38 39 39 SUBROUTINE obc_fla_ts 40 !!---------------------------------------------------------------------- --------40 !!---------------------------------------------------------------------- 41 41 !! 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) 46 45 !! 47 46 !! This routine is called in dynspg_ts.F90 routine … … 51 50 !! open one (must be done in the obc_par.F90 file). 52 51 !! 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 ! 60 55 IF( lp_obc_east ) CALL obc_fla_ts_east 61 56 IF( lp_obc_west ) CALL obc_fla_ts_west 62 57 IF( lp_obc_north ) CALL obc_fla_ts_north 63 58 IF( lp_obc_south ) CALL obc_fla_ts_south 64 59 ! 65 60 END SUBROUTINE obc_fla_ts 66 61 67 62 68 63 SUBROUTINE obc_fla_ts_east 69 !!---------------------------------------------------------------------- --------64 !!---------------------------------------------------------------------- 70 65 !! *** SUBROUTINE obc_fla_ts_east *** 71 66 !! 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 !!---------------------------------------------------------------------- 80 70 INTEGER :: ji, jj ! dummy loop indices 81 !!---------------------------------------------------------------------- --------82 71 !!---------------------------------------------------------------------- 72 ! 83 73 DO ji = nie0, nie1 84 74 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) 91 79 END DO 92 80 END DO 93 81 DO ji = nie0p1, nie1p1 94 82 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) 98 85 END DO 99 86 END DO 100 87 ! 101 88 END SUBROUTINE obc_fla_ts_east 102 89 103 90 104 91 SUBROUTINE obc_fla_ts_west 105 !!---------------------------------------------------------------------- --------92 !!---------------------------------------------------------------------- 106 93 !! *** SUBROUTINE obc_fla_ts_west *** 107 94 !! 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 !!---------------------------------------------------------------------- 116 98 INTEGER :: ji, jj ! dummy loop indices 117 !!---------------------------------------------------------------------- --------118 99 !!---------------------------------------------------------------------- 100 ! 119 101 DO ji = niw0, niw1 120 102 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) 132 109 END DO 133 110 END DO 134 111 ! 135 112 END SUBROUTINE obc_fla_ts_west 136 113 114 137 115 SUBROUTINE obc_fla_ts_north 138 !!---------------------------------------------------------------------- --------116 !!---------------------------------------------------------------------- 139 117 !! SUBROUTINE obc_fla_ts_north 140 !! *************************141 !! ** Purpose :142 !! Apply Flather's algorithm on north OBC velocities ua, va143 !! Fix sea surface height (sshn_e) on north open boundary144 118 !! 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 !!---------------------------------------------------------------------- 149 122 INTEGER :: ji, jj ! dummy loop indices 150 !!---------------------------------------------------------------------- --------151 123 !!---------------------------------------------------------------------- 124 ! 152 125 DO jj = njn0, njn1 153 126 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) 160 131 END DO 161 132 END DO 162 133 DO jj = njn0p1, njn1p1 163 134 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) 167 137 END DO 168 138 END DO 169 139 ! 170 140 END SUBROUTINE obc_fla_ts_north 171 141 142 172 143 SUBROUTINE obc_fla_ts_south 173 !!---------------------------------------------------------------------- --------144 !!---------------------------------------------------------------------- 174 145 !! SUBROUTINE obc_fla_ts_south 175 !! *************************176 !! ** Purpose :177 !! Apply Flather's algorithm on south OBC velocities ua, va178 !! Fix sea surface height (sshn_e) on south open boundary179 146 !! 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 !!---------------------------------------------------------------------- 184 150 INTEGER :: ji, jj ! dummy loop indices 185 186 !!------------------------------------------------------------------------------ 187 151 !!---------------------------------------------------------------------- 152 ! 188 153 DO jj = njs0, njs1 189 154 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) 201 161 END DO 202 162 END DO 203 163 ! 204 164 END SUBROUTINE obc_fla_ts_south 165 205 166 #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 !!---------------------------------------------------------------------- 210 170 CONTAINS 211 171 … … 214 174 END SUBROUTINE obc_fla_ts 215 175 #endif 216 176 !!====================================================================== 217 177 END MODULE obcfla
Note: See TracChangeset
for help on using the changeset viewer.
