Changeset 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC
- Timestamp:
- 2011-02-26T13:31:38+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC
- Files:
-
- 2 edited
-
obcdyn_bt.F90 (modified) (4 diffs)
-
obcfla.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90
r2528 r2618 16 16 17 17 !!---------------------------------------------------------------------------------- 18 !! * Modules used19 18 USE oce ! ocean dynamics and tracers 20 19 USE dom_oce ! ocean space and time domain … … 41 40 CONTAINS 42 41 43 SUBROUTINE obc_dyn_bt 42 SUBROUTINE obc_dyn_bt( kt ) 44 43 !!------------------------------------------------------------------------------ 45 44 !! SUBROUTINE obc_dyn_bt … … 55 54 !! open one (must be done in the param_obc.h90 file). 56 55 !! 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 56 !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 57 !! 58 !! History : 9.0 ! 05-12 (V. Garnier) original 62 59 !!---------------------------------------------------------------------- 63 60 !! * Arguments … … 321 318 !! 9.0 ! 05-12 (V. Garnier) original 322 319 !!------------------------------------------------------------------------------ 323 !! * Local declaration 324 INTEGER :: ji, jj, jk ! dummy loop indices 325 320 INTEGER :: ji, jj, jk ! dummy loop indices 326 321 !!------------------------------------------------------------------------------ 327 322 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90
r2528 r2618 5 5 !!====================================================================== 6 6 !! 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 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_obc && defined key_dynspg_ts … … 31 32 32 33 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010)34 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 34 35 !! $Id$ 35 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 37 38 CONTAINS 38 39 39 SUBROUTINE obc_fla_ts 40 SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 40 41 !!---------------------------------------------------------------------- 41 42 !! SUBROUTINE obc_fla_ts … … 52 53 !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 53 54 !!---------------------------------------------------------------------- 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 !!---------------------------------------------------------------------- 54 58 ! 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 ) 59 63 ! 60 64 END SUBROUTINE obc_fla_ts 61 65 62 66 63 SUBROUTINE obc_fla_ts_east 67 SUBROUTINE obc_fla_ts_east( pua, pva, p_sshn, p_ssha ) 64 68 !!---------------------------------------------------------------------- 65 69 !! *** SUBROUTINE obc_fla_ts_east *** 66 70 !! 67 71 !! ** Purpose : Apply Flather's algorithm on east OBC velocities ua, va 68 !! Fix sea surface height ( sshn_e) on east open boundary72 !! Fix sea surface height (p_sshn) on east open boundary 69 73 !!---------------------------------------------------------------------- 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 ! 70 77 INTEGER :: ji, jj ! dummy loop indices 71 78 !!---------------------------------------------------------------------- … … 73 80 DO ji = nie0, nie1 74 81 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) 77 84 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) 79 86 END DO 80 87 END DO 81 88 DO ji = nie0p1, nie1p1 82 89 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) 85 92 END DO 86 93 END DO … … 89 96 90 97 91 SUBROUTINE obc_fla_ts_west 98 SUBROUTINE obc_fla_ts_west( pua, pva, p_sshn, p_ssha ) 92 99 !!---------------------------------------------------------------------- 93 100 !! *** SUBROUTINE obc_fla_ts_west *** 94 101 !! 95 102 !! ** Purpose : Apply Flather's algorithm on west OBC velocities ua, va 96 !! Fix sea surface height ( sshn_e) on west open boundary103 !! Fix sea surface height (p_sshn) on west open boundary 97 104 !!---------------------------------------------------------------------- 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 ! 98 108 INTEGER :: ji, jj ! dummy loop indices 99 109 !!---------------------------------------------------------------------- … … 101 111 DO ji = niw0, niw1 102 112 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) 106 116 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) 109 119 END DO 110 120 END DO … … 113 123 114 124 115 SUBROUTINE obc_fla_ts_north 125 SUBROUTINE obc_fla_ts_north( pua, pva, p_sshn, p_ssha ) 116 126 !!---------------------------------------------------------------------- 117 127 !! SUBROUTINE obc_fla_ts_north 118 128 !! 119 129 !! ** Purpose : Apply Flather's algorithm on north OBC velocities ua, va 120 !! Fix sea surface height ( sshn_e) on north open boundary130 !! Fix sea surface height (p_sshn) on north open boundary 121 131 !!---------------------------------------------------------------------- 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 ! 122 135 INTEGER :: ji, jj ! dummy loop indices 123 136 !!---------------------------------------------------------------------- … … 125 138 DO jj = njn0, njn1 126 139 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) 129 142 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) 131 144 END DO 132 145 END DO 133 146 DO jj = njn0p1, njn1p1 134 147 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) 137 150 END DO 138 151 END DO … … 141 154 142 155 143 SUBROUTINE obc_fla_ts_south 156 SUBROUTINE obc_fla_ts_south( pua, pva, p_sshn, p_ssha ) 144 157 !!---------------------------------------------------------------------- 145 158 !! SUBROUTINE obc_fla_ts_south 146 159 !! 147 160 !! ** Purpose : Apply Flather's algorithm on south OBC velocities ua, va 148 !! Fix sea surface height ( sshn_e) on south open boundary161 !! Fix sea surface height (p_sshn) on south open boundary 149 162 !!---------------------------------------------------------------------- 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 ! 150 166 INTEGER :: ji, jj ! dummy loop indices 151 167 !!---------------------------------------------------------------------- … … 153 169 DO jj = njs0, njs1 154 170 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) 158 174 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) 161 177 END DO 162 178 END DO … … 170 186 CONTAINS 171 187 172 SUBROUTINE obc_fla_ts 173 WRITE(*,*) 'obc_fla_ts: You should not have seen this print! error?' 188 SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 189 REAL, DIMENSION(:,:):: pua, pva, p_sshn, p_ssha 190 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) 174 191 END SUBROUTINE obc_fla_ts 175 192 #endif
Note: See TracChangeset
for help on using the changeset viewer.
