Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 14 edited
-
divhor.F90 (modified) (1 diff)
-
dynbfr.F90 (modified) (4 diffs)
-
dynhpg.F90 (modified) (14 diffs)
-
dynkeg.F90 (modified) (5 diffs)
-
dynldf.F90 (modified) (3 diffs)
-
dynldf_lap_blp.F90 (modified) (5 diffs)
-
dynnxt.F90 (modified) (12 diffs)
-
dynspg.F90 (modified) (7 diffs)
-
dynspg_ts.F90 (modified) (49 diffs)
-
dynvor.F90 (modified) (24 diffs)
-
dynzad.F90 (modified) (6 diffs)
-
dynzdf.F90 (modified) (3 diffs)
-
dynzdf_imp.F90 (modified) (22 diffs)
-
sshwzv.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r6140 r7698 72 72 ENDIF 73 73 ! 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 74 75 DO jk = 1, jpkm1 !== Horizontal divergence ==! 75 76 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r6140 r7698 47 47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 48 !! 49 INTEGER :: j i, jj ! dummy loop indexes49 INTEGER :: jk, ji, jj ! dummy loop indexes 50 50 INTEGER :: ikbu, ikbv ! local integers 51 51 REAL(wp) :: zm1_2dt ! local scalar … … 65 65 IF( l_trddyn ) THEN ! trends: store the input trends 66 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 67 ztrdu(:,:,:) = ua(:,:,:) 68 ztrdv(:,:,:) = va(:,:,:) 67 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 68 DO jk = 1, jpk 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 72 ztrdv(ji,jj,jk) = va(ji,jj,jk) 73 END DO 74 END DO 75 END DO 69 76 ENDIF 70 77 71 78 79 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 72 80 DO jj = 2, jpjm1 73 81 DO ji = 2, jpim1 … … 82 90 ! 83 91 IF( ln_isfcav ) THEN ! ocean cavities 92 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 84 93 DO jj = 2, jpjm1 85 94 DO ji = 2, jpim1 … … 99 108 ! 100 109 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 101 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 102 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 111 DO jk = 1, jpk 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 115 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 116 END DO 117 END DO 118 END DO 103 119 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 104 120 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7646 r7698 84 84 !!---------------------------------------------------------------------- 85 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 INTEGER :: jk, jj, ji 86 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 87 88 !!---------------------------------------------------------------------- … … 91 92 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) 92 93 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 93 ztrdu(:,:,:) = ua(:,:,:) 94 ztrdv(:,:,:) = va(:,:,:) 94 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 95 DO jk = 1, jpk 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 99 ztrdv(ji,jj,jk) = va(ji,jj,jk) 100 END DO 101 END DO 102 END DO 95 103 ENDIF 96 104 ! … … 105 113 ! 106 114 IF( l_trddyn ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 107 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 116 DO jk = 1, jpk 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 120 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 121 END DO 122 END DO 123 END DO 109 124 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 110 125 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) … … 198 213 ! 199 214 ! initialisation of ice shelf load 200 IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 215 IF ( .NOT. ln_isfcav ) THEN 216 !$OMP PARALLEL DO schedule(static) private(jj, ji) 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 riceload(ji,jj)=0.0 220 END DO 221 END DO 222 END IF 201 223 IF ( ln_isfcav ) THEN 202 224 CALL wrk_alloc( jpi,jpj, 2, ztstop) … … 212 234 213 235 ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 214 ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 236 !$OMP PARALLEL DO schedule(static) private(jj, ji) 237 DO jj = 1, jpj 238 DO ji = 1, jpi 239 ztstop(ji,jj,1)=-1.9_wp 240 ztstop(ji,jj,2)=34.4_wp 241 END DO 242 END DO 215 243 216 244 ! compute density of the water displaced by the ice shelf … … 226 254 ! divided by 2 later 227 255 ziceload = 0._wp 256 !$OMP PARALLEL 257 !$OMP DO schedule(static) private(jj,ji,ikt,jk) 228 258 DO jj = 1, jpj 229 259 DO ji = 1, jpi … … 238 268 END DO 239 269 END DO 240 riceload(:,:)=ziceload(:,:) ! need to be saved for diaar5 270 !$OMP DO schedule(static) private(jj, ji) 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 riceload(ji,jj)=ziceload(ji,jj) ! need to be saved for diaar5 274 END DO 275 END DO 276 !$OMP END PARALLEL 241 277 242 278 CALL wrk_dealloc( jpi,jpj, 2, ztstop) … … 282 318 283 319 ! Surface value 320 !$OMP PARALLEL 321 !$OMP DO schedule(static) private(ji,jj, zcoef1) 284 322 DO jj = 2, jpjm1 285 323 DO ji = fs_2, fs_jpim1 ! vector opt. … … 297 335 ! interior value (2=<jk=<jpkm1) 298 336 DO jk = 2, jpkm1 337 !$OMP DO schedule(static) private(ji,jj, zcoef1) 299 338 DO jj = 2, jpjm1 300 339 DO ji = fs_2, fs_jpim1 ! vector opt. … … 313 352 END DO 314 353 END DO 315 END DO 354 !$OMP END DO NOWAIT 355 END DO 356 !$OMP END PARALLEL 316 357 ! 317 358 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) … … 351 392 352 393 ! Surface value (also valid in partial step case) 394 !$OMP PARALLEL 395 !$OMP DO schedule(static) private(ji,jj,zcoef1) 353 396 DO jj = 2, jpjm1 354 397 DO ji = fs_2, fs_jpim1 ! vector opt. … … 365 408 ! interior value (2=<jk=<jpkm1) 366 409 DO jk = 2, jpkm1 410 !$OMP DO schedule(static) private(ji,jj, zcoef1) 367 411 DO jj = 2, jpjm1 368 412 DO ji = fs_2, fs_jpim1 ! vector opt. … … 384 428 385 429 ! partial steps correction at the last level (use gru & grv computed in zpshde.F90) 430 !$OMP DO schedule(static) private(ji,jj,iku,ikv,zcoef2,zcoef3) 386 431 DO jj = 2, jpjm1 387 432 DO ji = 2, jpim1 … … 404 449 END DO 405 450 END DO 451 !$OMP END PARALLEL 406 452 ! 407 453 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7646 r7698 96 96 IF( l_trddyn ) THEN ! Save ua and va trends 97 97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 98 ztrdu(:,:,:) = ua(:,:,:) 99 ztrdv(:,:,:) = va(:,:,:) 100 ENDIF 101 102 zhke(:,:,jpk) = 0._wp 98 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 99 DO jk = 1, jpk 100 DO jj = 1, jpj 101 DO ji = 1, jpi 102 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 103 ztrdv(ji,jj,jk) = va(ji,jj,jk) 104 END DO 105 END DO 106 END DO 107 ENDIF 108 !$OMP PARALLEL DO schedule(static) private(jj, ji) 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 zhke(ji,jj,jpk) = 0._wp 112 END DO 113 END DO 103 114 104 115 IF (ln_bdy) THEN … … 133 144 ! 134 145 CASE ( nkeg_C2 ) !-- Standard scheme --! 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 135 147 DO jk = 1, jpkm1 136 148 DO jj = 2, jpj … … 146 158 ! 147 159 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 148 161 DO jk = 1, jpkm1 149 162 DO jj = 2, jpjm1 … … 168 181 IF (ln_bdy) THEN 169 182 ! restore velocity masks at points outside boundary 170 un(:,:,:) = un(:,:,:) * umask(:,:,:) 171 vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 172 ENDIF 173 174 175 ! 183 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 184 DO jk = 1, jpk 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 188 vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 189 END DO 190 END DO 191 END DO 192 ENDIF 193 194 ! 195 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 176 196 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! 177 197 DO jj = 2, jpjm1 … … 184 204 ! 185 205 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 186 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 187 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 207 DO jk = 1, jpk 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 211 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 212 END DO 213 END DO 214 END DO 188 215 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 189 216 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7646 r7698 61 61 !!---------------------------------------------------------------------- 62 62 INTEGER, INTENT(in) :: kt ! ocean time-step index 63 INTEGER :: jk, jj, ji 63 64 ! 64 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 69 70 IF( l_trddyn ) THEN ! temporary save of momentum trends 70 71 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 71 ztrdu(:,:,:) = ua(:,:,:) 72 ztrdv(:,:,:) = va(:,:,:) 72 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 73 DO jk = 1, jpk 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 77 ztrdv(ji,jj,jk) = va(ji,jj,jk) 78 END DO 79 END DO 80 END DO 73 81 ENDIF 74 82 … … 82 90 83 91 IF( l_trddyn ) THEN ! save the horizontal diffusive trends for further diagnostics 84 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 85 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 92 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 93 DO jk = 1, jpk 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 97 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 98 END DO 99 END DO 100 END DO 86 101 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 87 102 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r6140 r7698 75 75 ! 76 76 ! ! =============== 77 !$OMP PARALLEL 77 78 DO jk = 1, jpkm1 ! Horizontal slab 78 79 ! ! =============== 80 !$OMP DO schedule(static) private(jj, ji) 79 81 DO jj = 2, jpj 80 82 DO ji = fs_2, jpi ! vector opt. … … 93 95 END DO 94 96 ! 97 !$OMP DO schedule(static) private(jj, ji) 95 98 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 96 99 DO ji = fs_2, fs_jpim1 ! vector opt. … … 106 109 ! ! =============== 107 110 END DO ! End of slab 111 !$OMP END PARALLEL 108 112 ! ! =============== 109 113 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) … … 128 132 !!---------------------------------------------------------------------- 129 133 INTEGER , INTENT(in ) :: kt ! ocean time-step index 134 INTEGER :: jk, jj, ji 130 135 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 131 136 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend … … 144 149 ENDIF 145 150 ! 146 zulap(:,:,:) = 0._wp 147 zvlap(:,:,:) = 0._wp 151 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 152 DO jk = 1, jpk 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zulap(ji,jj,jk) = 0._wp 156 zvlap(ji,jj,jk) = 0._wp 157 END DO 158 END DO 159 END DO 148 160 ! 149 161 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r7646 r7698 115 115 ! Ensure below that barotropic velocities match time splitting estimate 116 116 ! Compute actual transport and replace it with ts estimate at "after" time step 117 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 118 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 117 !$OMP PARALLEL 118 !$OMP DO schedule(static) private(jj, ji) 119 DO jj = 1, jpj 120 DO ji = 1, jpi 121 zue(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) * umask(ji,jj,1) 122 zve(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) * vmask(ji,jj,1) 123 END DO 124 END DO 119 125 DO jk = 2, jpkm1 120 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 121 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 122 END DO 126 !$OMP DO schedule(static) private(jj,ji) 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 zue(ji,jj) = zue(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 130 zve(ji,jj) = zve(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 131 END DO 132 END DO 133 END DO 134 !$OMP DO schedule(static) private(jk,jj,ji) 123 135 DO jk = 1, jpkm1 124 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 125 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 126 END DO 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zue(ji,jj) * r1_hu_a(ji,jj) + ua_b(ji,jj) ) * umask(ji,jj,jk) 139 va(ji,jj,jk) = ( va(ji,jj,jk) - zve(ji,jj) * r1_hv_a(ji,jj) + va_b(ji,jj) ) * vmask(ji,jj,jk) 140 END DO 141 END DO 142 END DO 143 !$OMP END PARALLEL 127 144 ! 128 145 IF( .NOT.ln_bt_fw ) THEN … … 131 148 ! In the forward case, this is done below after asselin filtering 132 149 ! so that asselin contribution is removed at the same time 150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 133 151 DO jk = 1, jpkm1 134 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 135 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 136 END DO 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 un(ji,jj,jk) = ( un(ji,jj,jk) - un_adv(ji,jj) + un_b(ji,jj) )*umask(ji,jj,jk) 155 vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn_adv(ji,jj) + vn_b(ji,jj) )*vmask(ji,jj,jk) 156 END DO 157 END DO 158 END DO 159 137 160 ENDIF 138 161 ENDIF … … 161 184 ! 162 185 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 163 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 164 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 187 DO jk = 1, jpk 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_2dt 191 zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_2dt 192 END DO 193 END DO 194 END DO 165 195 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 166 196 CALL iom_put( "vtrd_tot", zva ) 167 197 ENDIF 168 198 ! 169 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter 170 zva(:,:,:) = vn(:,:,:) ! (caution: there will be a shift by 1 timestep in the 171 ! ! computation of the asselin filter trends) 199 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 200 DO jk = 1, jpk 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 zua(ji,jj,jk) = un(ji,jj,jk) ! save the now velocity before the asselin filter 204 zva(ji,jj,jk) = vn(ji,jj,jk) ! (caution: there will be a shift by 1 timestep in the 205 ! ! computation of the asselin filter trends) 206 END DO 207 END DO 208 END DO 172 209 ENDIF 173 210 … … 175 212 ! ------------------------------------------ 176 213 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 214 !$OMP PARALLEL 215 !$OMP DO schedule(static) private(jk,jj,ji) 177 216 DO jk = 1, jpkm1 178 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 179 vn(:,:,jk) = va(:,:,jk) 180 END DO 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 220 vn(ji,jj,jk) = va(ji,jj,jk) 221 END DO 222 END DO 223 END DO 224 !$OMP END DO NOWAIT 181 225 IF(.NOT.ln_linssh ) THEN 226 !$OMP DO schedule(static) private(jk,jj,ji) 182 227 DO jk = 1, jpkm1 183 e3t_b(:,:,jk) = e3t_n(:,:,jk) 184 e3u_b(:,:,jk) = e3u_n(:,:,jk) 185 e3v_b(:,:,jk) = e3v_n(:,:,jk) 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) 231 e3u_b(ji,jj,jk) = e3u_n(ji,jj,jk) 232 e3v_b(ji,jj,jk) = e3v_n(ji,jj,jk) 233 END DO 234 END DO 186 235 END DO 187 236 ENDIF 237 !$OMP END PARALLEL 188 238 ELSE !* Leap-Frog : Asselin filter and swap 189 239 ! ! =============! 190 240 IF( ln_linssh ) THEN ! Fixed volume ! 191 241 ! ! =============! 242 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 192 243 DO jk = 1, jpkm1 193 244 DO jj = 1, jpj … … 210 261 ! ---------------------------------------------------- 211 262 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 212 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 e3t_b(ji,jj,1:jpkm1) = e3t_n(ji,jj,1:jpkm1) 267 END DO 268 END DO 213 269 ELSE 270 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 214 271 DO jk = 1, jpkm1 215 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) + atfp * ( e3t_b(ji,jj,jk) - 2._wp * e3t_n(ji,jj,jk) + e3t_a(ji,jj,jk) ) 275 END DO 276 END DO 216 277 END DO 217 278 ! Add volume filter correction: compatibility with tracer advection scheme … … 219 280 zcoef = atfp * rdt * r1_rau0 220 281 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 221 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 222 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 282 !$OMP PARALLEL DO schedule(static) private(jj,ji) 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 e3t_b(ji,jj,1) = e3t_b(ji,jj,1) - zcoef * ( emp_b(ji,jj) - emp(ji,jj) & 286 & - rnf_b(ji,jj) + rnf(ji,jj) ) * tmask(ji,jj,1) 287 END DO 288 END DO 223 289 ELSE ! if ice shelf melting 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt) 224 291 DO jj = 1, jpj 225 292 DO ji = 1, jpi … … 237 304 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 238 305 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 306 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 239 307 DO jk = 1, jpkm1 240 308 DO jj = 1, jpj … … 257 325 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 258 326 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 327 !$OMP PARALLEL 328 !$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 259 329 DO jk = 1, jpkm1 260 330 DO jj = 1, jpj … … 277 347 END DO 278 348 END DO 279 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 280 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 349 !$OMP DO schedule(static) private(jj, ji) 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 e3u_b(ji,jj,1:jpkm1) = ze3u_f(ji,jj,1:jpkm1) ! e3u_b <-- filtered scale factor 353 e3v_b(ji,jj,1:jpkm1) = ze3v_f(ji,jj,1:jpkm1) 354 END DO 355 END DO 356 !$OMP END PARALLEL 281 357 ! 282 358 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) … … 288 364 ! Revert "before" velocities to time split estimate 289 365 ! Doing it here also means that asselin filter contribution is removed 290 zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 291 zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 366 !$OMP PARALLEL 367 !$OMP DO schedule(static) private(jj, ji) 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 zue(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 371 zve(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 372 END DO 373 END DO 292 374 DO jk = 2, jpkm1 293 zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 294 zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 295 END DO 375 !$OMP DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zue(ji,jj) = zue(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 379 zve(ji,jj) = zve(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 380 END DO 381 END DO 382 END DO 383 !$OMP DO schedule(static) private(jk,jj,ji) 296 384 DO jk = 1, jpkm1 297 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 298 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 299 END DO 385 DO jj = 1, jpj 386 DO ji = 1, jpi 387 ub(ji,jj,jk) = ub(ji,jj,jk) - (zue(ji,jj) * r1_hu_n(ji,jj) - un_b(ji,jj)) * umask(ji,jj,jk) 388 vb(ji,jj,jk) = vb(ji,jj,jk) - (zve(ji,jj) * r1_hv_n(ji,jj) - vn_b(ji,jj)) * vmask(ji,jj,jk) 389 END DO 390 END DO 391 END DO 392 !$OMP END PARALLEL 300 393 ENDIF 301 394 ! … … 308 401 ! 309 402 IF(.NOT.ln_linssh ) THEN 310 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 311 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 403 !$OMP PARALLEL 404 !$OMP DO schedule(static) private(jj, ji) 405 DO jj = 1, jpj 406 DO ji = 1, jpi 407 hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 408 hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 409 END DO 410 END DO 312 411 DO jk = 2, jpkm1 313 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 314 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 315 END DO 316 r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 317 r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 318 ENDIF 319 ! 320 un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 321 ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 322 vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 323 vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 412 !$OMP DO schedule(static) private(jj, ji) 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 416 hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 417 END DO 418 END DO 419 END DO 420 !$OMP DO schedule(static) private(jj, ji) 421 DO jj = 1, jpj 422 DO ji = 1, jpi 423 r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) 424 r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 425 END DO 426 END DO 427 !$OMP END PARALLEL 428 ENDIF 429 ! 430 !$OMP PARALLEL 431 !$OMP DO schedule(static) private(jj, ji) 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 un_b(ji,jj) = e3u_a(ji,jj,1) * un(ji,jj,1) * umask(ji,jj,1) 435 ub_b(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 436 vn_b(ji,jj) = e3v_a(ji,jj,1) * vn(ji,jj,1) * vmask(ji,jj,1) 437 vb_b(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 438 END DO 439 END DO 324 440 DO jk = 2, jpkm1 325 un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 326 ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 327 vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 328 vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 441 !$OMP DO schedule(static) private(jj, ji) 442 DO jj = 1, jpj 443 DO ji = 1, jpi 444 un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 445 ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 446 vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 447 vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 448 END DO 449 END DO 329 450 END DO 330 un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 331 vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 332 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 333 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 451 !$OMP DO schedule(static) private(jj, ji) 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 un_b(ji,jj) = un_b(ji,jj) * r1_hu_a(ji,jj) 455 vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_a(ji,jj) 456 ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 457 vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 458 END DO 459 END DO 460 !$OMP END PARALLEL 334 461 ! 335 462 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 338 465 ENDIF 339 466 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 340 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 341 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 467 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 468 DO jk = 1, jpkm1 469 DO jj = 1, jpj 470 DO ji = 1, jpi 471 zua(ji,jj,jk) = ( ub(ji,jj,jk) - zua(ji,jj,jk) ) * z1_2dt 472 zva(ji,jj,jk) = ( vb(ji,jj,jk) - zva(ji,jj,jk) ) * z1_2dt 473 END DO 474 END DO 475 END DO 342 476 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 343 477 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7646 r7698 83 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 85 ztrdu(:,:,:) = ua(:,:,:) 86 ztrdv(:,:,:) = va(:,:,:) 85 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 86 DO jk = 1, jpk 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 90 ztrdv(ji,jj,jk) = va(ji,jj,jk) 91 END DO 92 END DO 93 END DO 87 94 ENDIF 88 95 ! … … 91 98 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 92 99 ! 100 !$OMP PARALLEL DO schedule(static) private(jj, ji) 93 101 DO jj = 2, jpjm1 94 102 DO ji = fs_2, fs_jpim1 ! vector opt. … … 100 108 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 101 109 zg_2 = grav * 0.5 110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 102 111 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh 103 112 DO ji = fs_2, fs_jpim1 ! vector opt. … … 115 124 CALL upd_tide( kt ) ! update tide potential 116 125 ! 126 !$OMP PARALLEL DO schedule(static) private(jj, ji) 117 127 DO jj = 2, jpjm1 ! add tide potential forcing 118 128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 128 138 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 129 139 zgrau0r = - grav * r1_rau0 130 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 140 !$OMP PARALLEL 141 !$OMP DO schedule(static) private(jj, ji) 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 zpice(ji,jj) = ( zintp * snwice_mass(ji,jj) + ( 1.- zintp ) * snwice_mass_b(ji,jj) ) * zgrau0r 145 END DO 146 END DO 147 !$OMP DO schedule(static) private(jj, ji) 131 148 DO jj = 2, jpjm1 132 149 DO ji = fs_2, fs_jpim1 ! vector opt. … … 135 152 END DO 136 153 END DO 154 !$OMP END PARALLEL 137 155 ! 138 156 CALL wrk_dealloc( jpi,jpj, zpice ) 139 157 ENDIF 140 158 ! 159 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 141 160 DO jk = 1, jpkm1 !== Add all terms to the general trend 142 161 DO jj = 2, jpjm1 … … 158 177 ! 159 178 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 160 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 179 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 180 DO jk = 1, jpk 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 184 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 185 END DO 186 END DO 187 END DO 162 188 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 163 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7646 r7698 223 223 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 224 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 225 226 DO jj = 1, jpjm1 226 227 DO ji = 1, jpim1 … … 231 232 END DO 232 233 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 234 !$OMP PARALLEL DO schedule(static) private(jj, ji) 233 235 DO jj = 1, jpjm1 234 236 DO ji = 1, jpim1 … … 243 245 CALL lbc_lnk( zwz, 'F', 1._wp ) 244 246 ! 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 247 !$OMP PARALLEL 248 !$OMP DO schedule(static) private(jj) 249 DO jj = 1, jpj 250 ftne(1,jj) = 0._wp ; ftnw(1,jj) = 0._wp ; ftse(1,jj) = 0._wp ; ftsw(1,jj) = 0._wp 251 END DO 252 !$OMP DO schedule(static) private(jj, ji) 246 253 DO jj = 2, jpj 247 254 DO ji = 2, jpi … … 252 259 END DO 253 260 END DO 261 !$OMP END PARALLEL 254 262 ! 255 263 ELSE !== all other schemes (ENE, ENS, MIX) 256 zwz(:,:) = 0._wp 257 zhf(:,:) = 0._wp 264 !$OMP PARALLEL DO schedule(static) private(jj, ji) 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 zwz(ji,jj) = 0._wp 268 zhf(ji,jj) = 0._wp 269 END DO 270 END DO 258 271 259 272 !!gm assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed … … 275 288 ELSE 276 289 !zhf(:,:) = hbatf(:,:) 290 !$OMP PARALLEL DO schedule(static) private(ji,jj) 277 291 DO jj = 1, jpjm1 278 292 DO ji = 1, jpim1 … … 289 303 END IF 290 304 305 !$OMP PARALLEL 306 !$OMP DO schedule(static) private(ji,jj) 291 307 DO jj = 1, jpjm1 292 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 308 DO ji = 1, jpim1 309 zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 310 END DO 293 311 END DO 294 312 !!gm end 295 313 296 314 DO jk = 1, jpkm1 315 !$OMP DO schedule(static) private(ji,jj) 297 316 DO jj = 1, jpjm1 298 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 299 END DO 300 END DO 317 DO ji = 1, jpi 318 zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 319 END DO 320 END DO 321 END DO 322 !$OMP END PARALLEL 301 323 CALL lbc_lnk( zhf, 'F', 1._wp ) 302 324 ! JC: TBC. hf should be greater than 0 325 !$OMP PARALLEL 326 !$OMP DO schedule(static) private(jj, ji) 303 327 DO jj = 1, jpj 304 328 DO ji = 1, jpi … … 306 330 END DO 307 331 END DO 308 zwz(:,:) = ff_f(:,:) * zwz(:,:) 332 !$OMP DO schedule(static) private(jj, ji) 333 DO jj = 1, jpj 334 DO ji = 1, jpi 335 zwz(ji,jj) = ff_f(ji,jj) * zwz(ji,jj) 336 END DO 337 END DO 338 !$OMP END PARALLEL 309 339 ENDIF 310 340 ENDIF … … 324 354 ! !* e3*d/dt(Ua) (Vertically integrated) 325 355 ! ! -------------------------------------------------- 326 zu_frc(:,:) = 0._wp 327 zv_frc(:,:) = 0._wp 356 !$OMP PARALLEL 357 !$OMP DO schedule(static) private(jj, ji) 358 DO jj = 1, jpj 359 DO ji = 1, jpi 360 zu_frc(ji,jj) = 0._wp 361 zv_frc(ji,jj) = 0._wp 362 END DO 363 END DO 328 364 ! 329 365 DO jk = 1, jpkm1 330 zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 331 zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 366 !$OMP DO schedule(static) private(jj,ji) 367 DO jj=1,jpj 368 DO ji=1,jpi 369 zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 370 zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 371 END DO 372 END DO 332 373 END DO 333 374 ! 334 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 335 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 336 ! 375 !$OMP DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zu_frc(ji,jj) = zu_frc(ji,jj) * r1_hu_n(ji,jj) 379 zv_frc(ji,jj) = zv_frc(ji,jj) * r1_hv_n(ji,jj) 380 END DO 381 END DO 337 382 ! 338 383 ! !* baroclinic momentum trend (remove the vertical mean trend) 384 !$OMP DO schedule(static) private(jk,jj,ji) 339 385 DO jk = 1, jpkm1 ! ----------------------------------------------------------- 340 386 DO jj = 2, jpjm1 … … 345 391 END DO 346 392 END DO 393 !$OMP END DO NOWAIT 347 394 348 395 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... … … 352 399 ! !* barotropic Coriolis trends (vorticity scheme dependent) 353 400 ! ! -------------------------------------------------------- 354 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 401 !$OMP DO schedule(static) private(jj, ji) 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 zwx(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) ! now fluxes 405 zwy(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 406 END DO 407 END DO 408 !$OMP END PARALLEL 356 409 ! 357 410 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme 411 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 358 412 DO jj = 2, jpjm1 359 413 DO ji = fs_2, fs_jpim1 ! vector opt. … … 369 423 ! 370 424 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1) 371 426 DO jj = 2, jpjm1 372 427 DO ji = fs_2, fs_jpim1 ! vector opt. … … 381 436 ! 382 437 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 438 !$OMP PARALLEL DO schedule(static) private(jj,ji) 383 439 DO jj = 2, jpjm1 384 440 DO ji = fs_2, fs_jpim1 ! vector opt. … … 400 456 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 401 457 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 402 459 DO jj = 2, jpjm1 403 460 DO ji = 2, jpim1 … … 440 497 END DO 441 498 499 !$OMP PARALLEL DO schedule(static) private(jj,ji) 442 500 DO jj = 2, jpjm1 443 501 DO ji = 2, jpim1 … … 451 509 ELSE 452 510 511 !$OMP PARALLEL DO schedule(static) private(jj,ji) 453 512 DO jj = 2, jpjm1 454 513 DO ji = fs_2, fs_jpim1 ! vector opt. … … 461 520 ENDIF 462 521 522 !$OMP PARALLEL DO schedule(static) private(jj,ji) 463 523 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 464 524 DO ji = fs_2, fs_jpim1 … … 470 530 ! ! Add bottom stress contribution from baroclinic velocities: 471 531 IF (ln_bt_fw) THEN 532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 472 533 DO jj = 2, jpjm1 473 534 DO ji = fs_2, fs_jpim1 ! vector opt. … … 479 540 END DO 480 541 ELSE 542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 481 543 DO jj = 2, jpjm1 482 544 DO ji = fs_2, fs_jpim1 ! vector opt. … … 491 553 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 492 554 IF( ln_wd ) THEN 493 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 494 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi ! vector opt. 558 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX(r1_hu_n(ji,jj) * bfrua(ji,jj),-1._wp / rdtbt) * zwx(ji,jj) 559 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX(r1_hv_n(ji,jj) * bfrva(ji,jj),-1._wp / rdtbt) * zwy(ji,jj) 560 END DO 561 END DO 495 562 ELSE 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 563 !$OMP PARALLEL DO schedule(static) private(jj,ji) 564 DO jj = 1, jpj 565 DO ji = 1, jpi 566 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 567 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 568 END DO 569 END DO 498 570 END IF 499 571 ! 500 572 ! ! Add top stress contribution from baroclinic velocities: 501 573 IF( ln_bt_fw ) THEN 574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 502 575 DO jj = 2, jpjm1 503 576 DO ji = fs_2, fs_jpim1 ! vector opt. … … 509 582 END DO 510 583 ELSE 584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 511 585 DO jj = 2, jpjm1 512 586 DO ji = fs_2, fs_jpim1 ! vector opt. … … 520 594 ! 521 595 ! Note that the "unclipped" top friction parameter is used even with explicit drag 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 596 !$OMP PARALLEL DO schedule(static) private(jj,ji) 597 DO jj = 1, jpj 598 DO ji = 1, jpi 599 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 600 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 601 END DO 602 END DO 524 603 ! 525 604 IF (ln_bt_fw) THEN ! Add wind forcing 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 605 !$OMP PARALLEL DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 609 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 610 END DO 611 END DO 528 612 ELSE 529 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 530 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 613 !$OMP PARALLEL DO schedule(static) private(jj,ji) 614 DO jj = 1, jpj 615 DO ji = 1, jpi 616 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 617 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 618 END DO 619 END DO 531 620 ENDIF 532 621 ! 533 622 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 534 623 IF (ln_bt_fw) THEN 624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 535 625 DO jj = 2, jpjm1 536 626 DO ji = fs_2, fs_jpim1 ! vector opt. … … 542 632 END DO 543 633 ELSE 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 544 635 DO jj = 2, jpjm1 545 636 DO ji = fs_2, fs_jpim1 ! vector opt. … … 558 649 ! ! Surface net water flux and rivers 559 650 IF (ln_bt_fw) THEN 560 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 651 !$OMP PARALLEL DO schedule(static) private(jj,ji) 652 DO jj = 1, jpj 653 DO ji = 1, jpi 654 zssh_frc(ji,jj) = zraur * ( emp(ji,jj) - rnf(ji,jj) + fwfisf(ji,jj) ) 655 END DO 656 END DO 561 657 ELSE 562 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 563 & + fwfisf(:,:) + fwfisf_b(:,:) ) 658 !$OMP PARALLEL DO schedule(static) private(jj,ji) 659 DO jj = 1, jpj 660 DO ji = 1, jpi 661 zssh_frc(ji,jj) = zraur * z1_2 * ( emp(ji,jj) + emp_b(ji,jj) - rnf(ji,jj) - rnf_b(ji,jj) & 662 & + fwfisf(ji,jj) + fwfisf_b(ji,jj) ) 663 END DO 664 END DO 564 665 ENDIF 565 666 ! 566 667 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 567 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 668 !$OMP PARALLEL DO schedule(static) private(jj,ji) 669 DO jj = 1, jpj 670 DO ji = 1, jpi 671 zssh_frc(ji,jj) = zssh_frc(ji,jj) + div_sd(ji,jj) 672 END DO 673 END DO 568 674 ENDIF 569 675 ! … … 571 677 ! ! Include the IAU weighted SSH increment 572 678 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 573 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 679 !$OMP PARALLEL DO schedule(static) private(jj,ji) 680 DO jj = 1, jpj 681 DO ji = 1, jpi 682 zssh_frc(ji,jj) = zssh_frc(ji,jj) - ssh_iau(ji,jj) 683 END DO 684 END DO 574 685 ENDIF 575 686 #endif … … 589 700 ! Initialize barotropic variables: 590 701 IF( ll_init )THEN 591 sshbb_e(:,:) = 0._wp 592 ubb_e (:,:) = 0._wp 593 vbb_e (:,:) = 0._wp 594 sshb_e (:,:) = 0._wp 595 ub_e (:,:) = 0._wp 596 vb_e (:,:) = 0._wp 702 !$OMP PARALLEL DO schedule(static) private(jj,ji) 703 DO jj = 1, jpj 704 DO ji = 1, jpi 705 sshbb_e(ji,jj) = 0._wp 706 ubb_e (ji,jj) = 0._wp 707 vbb_e (ji,jj) = 0._wp 708 sshb_e (ji,jj) = 0._wp 709 ub_e (ji,jj) = 0._wp 710 vb_e (ji,jj) = 0._wp 711 END DO 712 END DO 597 713 ENDIF 598 714 599 715 ! 600 716 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 601 sshn_e(:,:) = sshn(:,:) 602 un_e (:,:) = un_b(:,:) 603 vn_e (:,:) = vn_b(:,:) 604 ! 605 hu_e (:,:) = hu_n(:,:) 606 hv_e (:,:) = hv_n(:,:) 607 hur_e (:,:) = r1_hu_n(:,:) 608 hvr_e (:,:) = r1_hv_n(:,:) 717 !$OMP PARALLEL DO schedule(static) private(jj,ji) 718 DO jj = 1, jpj 719 DO ji = 1, jpi 720 sshn_e(ji,jj) = sshn(ji,jj) 721 un_e (ji,jj) = un_b(ji,jj) 722 vn_e (ji,jj) = vn_b(ji,jj) 723 ! 724 hu_e (ji,jj) = hu_n(ji,jj) 725 hv_e (ji,jj) = hv_n(ji,jj) 726 hur_e (ji,jj) = r1_hu_n(ji,jj) 727 hvr_e (ji,jj) = r1_hv_n(ji,jj) 728 END DO 729 END DO 609 730 ELSE ! CENTRED integration: start from BEFORE fields 610 sshn_e(:,:) = sshb(:,:) 611 un_e (:,:) = ub_b(:,:) 612 vn_e (:,:) = vb_b(:,:) 613 ! 614 hu_e (:,:) = hu_b(:,:) 615 hv_e (:,:) = hv_b(:,:) 616 hur_e (:,:) = r1_hu_b(:,:) 617 hvr_e (:,:) = r1_hv_b(:,:) 731 !$OMP PARALLEL DO schedule(static) private(jj,ji) 732 DO jj = 1, jpj 733 DO ji = 1, jpi 734 sshn_e(ji,jj) = sshb(ji,jj) 735 un_e (ji,jj) = ub_b(ji,jj) 736 vn_e (ji,jj) = vb_b(ji,jj) 737 ! 738 hu_e (ji,jj) = hu_b(ji,jj) 739 hv_e (ji,jj) = hv_b(ji,jj) 740 hur_e (ji,jj) = r1_hu_b(ji,jj) 741 hvr_e (ji,jj) = r1_hv_b(ji,jj) 742 END DO 743 END DO 618 744 ENDIF 619 745 ! … … 621 747 ! 622 748 ! Initialize sums: 623 ua_b (:,:) = 0._wp ! After barotropic velocities (or transport if flux form) 624 va_b (:,:) = 0._wp 625 ssha (:,:) = 0._wp ! Sum for after averaged sea level 626 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 627 vn_adv(:,:) = 0._wp 749 !$OMP PARALLEL DO schedule(static) private(jj,ji) 750 DO jj = 1, jpj 751 DO ji = 1, jpi 752 ua_b (ji,jj) = 0._wp ! After barotropic velocities (or transport if flux form) 753 va_b (ji,jj) = 0._wp 754 ssha (ji,jj) = 0._wp ! Sum for after averaged sea level 755 un_adv(ji,jj) = 0._wp ! Sum for now transport issued from ts loop 756 vn_adv(ji,jj) = 0._wp 757 END DO 758 END DO 628 759 ! ! ==================== ! 629 760 DO jn = 1, icycle ! sub-time-step loop ! … … 649 780 650 781 ! Extrapolate barotropic velocities at step jit+0.5: 651 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 652 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 782 !$OMP PARALLEL DO schedule(static) private(jj,ji) 783 DO jj = 1, jpj 784 DO ji = 1, jpi 785 ua_e(ji,jj) = za1 * un_e(ji,jj) + za2 * ub_e(ji,jj) + za3 * ubb_e(ji,jj) 786 va_e(ji,jj) = za1 * vn_e(ji,jj) + za2 * vb_e(ji,jj) + za3 * vbb_e(ji,jj) 787 END DO 788 END DO 653 789 654 790 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 655 791 ! ! ------------------ 656 792 ! Extrapolate Sea Level at step jit+0.5: 657 zsshp2_e(:,:) = za1 * sshn_e(:,:) + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 793 !$OMP PARALLEL 794 !$OMP DO schedule(static) private(jj,ji) 795 DO jj = 1, jpj 796 DO ji = 1, jpi 797 zsshp2_e(ji,jj) = za1 * sshn_e(ji,jj) + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 798 END DO 799 END DO 658 800 ! 801 !$OMP DO schedule(static) private(jj,ji) 659 802 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 660 803 DO ji = 2, fs_jpim1 ! Vector opt. … … 667 810 END DO 668 811 END DO 812 !$OMP END PARALLEL 669 813 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 670 814 ! 671 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 672 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 815 !$OMP PARALLEL DO schedule(static) private(jj,ji) 816 DO jj = 1, jpj 817 DO ji = 1, jpi 818 zhup2_e (ji,jj) = hu_0(ji,jj) + zwx(ji,jj) ! Ocean depth at U- and V-points 819 zhvp2_e (ji,jj) = hv_0(ji,jj) + zwy(ji,jj) 820 END DO 821 END DO 673 822 ELSE 674 zhup2_e (:,:) = hu_n(:,:) 675 zhvp2_e (:,:) = hv_n(:,:) 823 !$OMP PARALLEL DO schedule(static) private(jj,ji) 824 DO jj = 1, jpj 825 DO ji = 1, jpi 826 zhup2_e (ji,jj) = hu_n(ji,jj) 827 zhvp2_e (ji,jj) = hv_n(ji,jj) 828 END DO 829 END DO 676 830 ENDIF 677 831 ! !* after ssh … … 680 834 ! considering fluxes below: 681 835 ! 682 zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 683 zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 836 !$OMP PARALLEL DO schedule(static) private(jj,ji) 837 DO jj = 1, jpj 838 DO ji = 1, jpi 839 zwx(ji,jj) = e2u(ji,jj) * ua_e(ji,jj) * zhup2_e(ji,jj) ! fluxes at jn+0.5 840 zwy(ji,jj) = e1v(ji,jj) * va_e(ji,jj) * zhvp2_e(ji,jj) 841 END DO 842 END DO 843 684 844 ! 685 845 #if defined key_agrif … … 712 872 ! Sum over sub-time-steps to compute advective velocities 713 873 za2 = wgtbtp2(jn) 714 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 715 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 874 !$OMP PARALLEL 875 !$OMP DO schedule(static) private(jj,ji) 876 DO jj = 1, jpj 877 DO ji = 1, jpi 878 un_adv(ji,jj) = un_adv(ji,jj) + za2 * zwx(ji,jj) * r1_e2u(ji,jj) 879 vn_adv(ji,jj) = vn_adv(ji,jj) + za2 * zwy(ji,jj) * r1_e1v(ji,jj) 880 END DO 881 END DO 882 !$OMP END DO NOWAIT 716 883 ! 717 884 ! Set next sea level: 885 !$OMP DO schedule(static) private(jj,ji) 718 886 DO jj = 2, jpjm1 719 887 DO ji = fs_2, fs_jpim1 ! vector opt. … … 722 890 END DO 723 891 END DO 724 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 725 892 !$OMP DO schedule(static) private(jj,ji) 893 DO jj = 1, jpj 894 DO ji = 1, jpi 895 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 896 END DO 897 END DO 898 !$OMP END PARALLEL 726 899 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 727 900 … … 734 907 ! Sea Surface Height at u-,v-points (vvl case only) 735 908 IF( .NOT.ln_linssh ) THEN 909 !$OMP PARALLEL DO schedule(static) private(jj,ji) 736 910 DO jj = 2, jpjm1 737 911 DO ji = 2, jpim1 ! NO Vector Opt. … … 766 940 ENDIF 767 941 ! 768 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 769 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 942 !$OMP PARALLEL DO schedule(static) private(jj,ji) 943 DO jj = 1, jpj 944 DO ji = 1, jpi 945 zsshp2_e(ji,jj) = za0 * ssha_e(ji,jj) + za1 * sshn_e (ji,jj) & 946 & + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 947 END DO 948 END DO 770 949 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 771 951 DO jj = 2, jpjm1 772 952 DO ji = 2, jpim1 … … 813 993 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 814 994 ! 995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 815 996 DO jj = 2, jpjm1 816 997 DO ji = 2, jpim1 … … 826 1007 END DO 827 1008 1009 IF( ln_wd ) THEN 1010 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1011 DO jj = 1, jpj 1012 DO ji = 1, jpi ! vector opt. 1013 zhust_e(ji,jj) = MAX(zhust_e (ji,jj), rn_wdmin1 ) 1014 zhvst_e(ji,jj) = MAX(zhvst_e (ji,jj), rn_wdmin1 ) 1015 END DO 1016 END DO 1017 END IF 828 1018 ENDIF 829 1019 ! … … 836 1026 ! 837 1027 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN !== energy conserving or mixed scheme ==! 1028 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 838 1029 DO jj = 2, jpjm1 839 1030 DO ji = fs_2, fs_jpim1 ! vector opt. … … 848 1039 ! 849 1040 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 850 1042 DO jj = 2, jpjm1 851 1043 DO ji = fs_2, fs_jpim1 ! vector opt. … … 860 1052 ! 861 1053 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 1054 !$OMP PARALLEL DO schedule(static) private(jj,ji) 862 1055 DO jj = 2, jpjm1 863 1056 DO ji = fs_2, fs_jpim1 ! vector opt. … … 877 1070 ! Add tidal astronomical forcing if defined 878 1071 IF ( ln_tide .AND. ln_tide_pot ) THEN 1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 879 1073 DO jj = 2, jpjm1 880 1074 DO ji = fs_2, fs_jpim1 ! vector opt. … … 888 1082 ! 889 1083 ! Add bottom stresses: 890 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 891 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 892 ! 893 ! Add top stresses: 894 zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 895 zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 1084 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1085 DO jj = 1, jpj 1086 DO ji = 1, jpi 1087 zu_trd(ji,jj) = zu_trd(ji,jj) + bfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1088 zv_trd(ji,jj) = zv_trd(ji,jj) + bfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1089 ! 1090 ! Add top stresses: 1091 zu_trd(ji,jj) = zu_trd(ji,jj) + tfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1092 zv_trd(ji,jj) = zv_trd(ji,jj) + tfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1093 END DO 1094 END DO 1095 896 1096 ! 897 1097 ! Surface pressure trend: 898 1098 899 1099 IF( ln_wd ) THEN 1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 900 1101 DO jj = 2, jpjm1 901 1102 DO ji = 2, jpim1 … … 908 1109 END DO 909 1110 ELSE 1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 910 1112 DO jj = 2, jpjm1 911 1113 DO ji = fs_2, fs_jpim1 ! vector opt. … … 922 1124 ! Set next velocities: 923 1125 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 1126 !$OMP PARALLEL DO schedule(static) private(jj,ji) 924 1127 DO jj = 2, jpjm1 925 1128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 939 1142 ! 940 1143 ELSE !* Flux form 1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra) 941 1145 DO jj = 2, jpjm1 942 1146 DO ji = fs_2, fs_jpim1 ! vector opt. … … 969 1173 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 970 1174 IF( ln_wd ) THEN 971 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 972 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 1175 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1176 DO jj = 1, jpj 1177 DO ji = 1, jpi ! vector opt. 1178 hu_e (ji,jj) = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1) 1179 hv_e (ji,jj) = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1) 1180 END DO 1181 END DO 973 1182 ELSE 974 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 975 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1183 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1184 DO jj = 1, jpj 1185 DO ji = 1, jpi 1186 hu_e (ji,jj) = hu_0(ji,jj) + zsshu_a(ji,jj) 1187 hv_e (ji,jj) = hv_0(ji,jj) + zsshv_a(ji,jj) 1188 END DO 1189 END DO 976 1190 END IF 977 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 978 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 1191 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1192 DO jj = 1, jpj 1193 DO ji = 1, jpi 1194 hur_e(ji,jj) = ssumask(ji,jj) / ( hu_e(ji,jj) + 1._wp - ssumask(ji,jj) ) 1195 hvr_e(ji,jj) = ssvmask(ji,jj) / ( hv_e(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1196 END DO 1197 END DO 979 1198 ! 980 1199 ENDIF … … 989 1208 ! !* Swap 990 1209 ! ! ---- 991 ubb_e (:,:) = ub_e (:,:) 992 ub_e (:,:) = un_e (:,:) 993 un_e (:,:) = ua_e (:,:) 994 ! 995 vbb_e (:,:) = vb_e (:,:) 996 vb_e (:,:) = vn_e (:,:) 997 vn_e (:,:) = va_e (:,:) 998 ! 999 sshbb_e(:,:) = sshb_e(:,:) 1000 sshb_e (:,:) = sshn_e(:,:) 1001 sshn_e (:,:) = ssha_e(:,:) 1210 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1211 DO jj = 1, jpj 1212 DO ji = 1, jpi 1213 ubb_e (ji,jj) = ub_e (ji,jj) 1214 ub_e (ji,jj) = un_e (ji,jj) 1215 un_e (ji,jj) = ua_e (ji,jj) 1216 ! 1217 vbb_e (ji,jj) = vb_e (ji,jj) 1218 vb_e (ji,jj) = vn_e (ji,jj) 1219 vn_e (ji,jj) = va_e (ji,jj) 1220 ! 1221 sshbb_e(ji,jj) = sshb_e(ji,jj) 1222 sshb_e (ji,jj) = sshn_e(ji,jj) 1223 sshn_e (ji,jj) = ssha_e(ji,jj) 1224 END DO 1225 END DO 1002 1226 1003 1227 ! !* Sum over whole bt loop … … 1005 1229 za1 = wgtbtp1(jn) 1006 1230 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 1007 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 1008 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1232 DO jj = 1, jpj 1233 DO ji = 1, jpi 1234 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) 1235 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) 1236 END DO 1237 END DO 1009 1238 ELSE ! Sum transports 1010 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1011 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) 1239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1240 DO jj = 1, jpj 1241 DO ji = 1, jpi 1242 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) * hu_e (ji,jj) 1243 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) * hv_e (ji,jj) 1244 END DO 1245 END DO 1012 1246 ENDIF 1013 1247 ! ! Sum sea level 1014 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1249 DO jj = 1, jpj 1250 DO ji = 1, jpi 1251 ssha(ji,jj) = ssha(ji,jj) + za1 * ssha_e(ji,jj) 1252 END DO 1253 END DO 1015 1254 ! ! ==================== ! 1016 1255 END DO ! end loop ! … … 1021 1260 ! 1022 1261 ! Set advection velocity correction: 1023 zwx(:,:) = un_adv(:,:) 1024 zwy(:,:) = vn_adv(:,:) 1262 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1263 DO jj = 1, jpj 1264 DO ji = 1, jpi 1265 zwx(ji,jj) = un_adv(ji,jj) 1266 zwy(ji,jj) = vn_adv(ji,jj) 1267 END DO 1268 END DO 1025 1269 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 1026 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1027 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1270 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1271 DO jj = 1, jpj 1272 DO ji = 1, jpi 1273 un_adv(ji,jj) = zwx(ji,jj) * r1_hu_n(ji,jj) 1274 vn_adv(ji,jj) = zwy(ji,jj) * r1_hv_n(ji,jj) 1275 END DO 1276 END DO 1028 1277 ELSE 1029 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1030 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1279 DO jj = 1, jpj 1280 DO ji = 1, jpi 1281 un_adv(ji,jj) = z1_2 * ( ub2_b(ji,jj) + zwx(ji,jj) ) * r1_hu_n(ji,jj) 1282 vn_adv(ji,jj) = z1_2 * ( vb2_b(ji,jj) + zwy(ji,jj) ) * r1_hv_n(ji,jj) 1283 END DO 1284 END DO 1031 1285 END IF 1032 1286 1033 1287 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 1034 ub2_b(:,:) = zwx(:,:) 1035 vb2_b(:,:) = zwy(:,:) 1288 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1289 DO jj = 1, jpj 1290 DO ji = 1, jpi 1291 ub2_b(ji,jj) = zwx(ji,jj) 1292 vb2_b(ji,jj) = zwy(ji,jj) 1293 END DO 1294 END DO 1036 1295 ENDIF 1037 1296 ! 1038 1297 ! Update barotropic trend: 1039 1298 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1040 1300 DO jk=1,jpkm1 1041 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 1042 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 1301 DO jj = 1, jpj 1302 DO ji = 1, jpi 1303 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ua_b(ji,jj) - ub_b(ji,jj) ) * z1_2dt_b 1304 va(ji,jj,jk) = va(ji,jj,jk) + ( va_b(ji,jj) - vb_b(ji,jj) ) * z1_2dt_b 1305 END DO 1306 END DO 1043 1307 END DO 1044 1308 ELSE 1045 1309 ! At this stage, ssha has been corrected: compute new depths at velocity points 1310 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1046 1311 DO jj = 1, jpjm1 1047 1312 DO ji = 1, jpim1 ! NO Vector Opt. … … 1056 1321 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1057 1322 ! 1323 !$OMP PARALLEL 1324 !$OMP DO schedule(static) private(jk,jj,ji) 1058 1325 DO jk=1,jpkm1 1059 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 1060 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 1061 END DO 1326 DO jj = 1, jpj 1327 DO ji = 1, jpi 1328 ua(ji,jj,jk) = ua(ji,jj,jk) + r1_hu_n(ji,jj) * ( ua_b(ji,jj) - ub_b(ji,jj) * hu_b(ji,jj) ) * z1_2dt_b 1329 va(ji,jj,jk) = va(ji,jj,jk) + r1_hv_n(ji,jj) * ( va_b(ji,jj) - vb_b(ji,jj) * hv_b(ji,jj) ) * z1_2dt_b 1330 END DO 1331 END DO 1332 END DO 1333 !$OMP END DO NOWAIT 1062 1334 ! Save barotropic velocities not transport: 1063 ua_b(:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 1064 va_b(:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 1065 ENDIF 1066 ! 1335 !$OMP DO schedule(static) private(jj,ji) 1336 DO jj = 1, jpj 1337 DO ji = 1, jpi 1338 ua_b(ji,jj) = ua_b(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 1339 va_b(ji,jj) = va_b(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1340 END DO 1341 END DO 1342 !$OMP END PARALLEL 1343 ENDIF 1344 ! 1345 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1067 1346 DO jk = 1, jpkm1 1068 ! Correct velocities: 1069 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 1070 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 1071 ! 1347 DO jj = 1, jpj 1348 DO ji = 1, jpi 1349 ! Correct velocities: 1350 un(ji,jj,jk) = ( un(ji,jj,jk) + un_adv(ji,jj) - un_b(ji,jj) ) * umask(ji,jj,jk) 1351 vn(ji,jj,jk) = ( vn(ji,jj,jk) + vn_adv(ji,jj) - vn_b(ji,jj) ) * vmask(ji,jj,jk) 1352 ! 1353 END DO 1354 END DO 1072 1355 END DO 1073 1356 ! … … 1081 1364 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1082 1365 IF( Agrif_NbStepint() == 0 ) THEN 1083 ub2_i_b(:,:) = 0._wp 1084 vb2_i_b(:,:) = 0._wp 1366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1367 DO jj = 1, jpj 1368 DO ji = 1, jpi 1369 ub2_i_b(ji,jj) = 0._wp 1370 vb2_i_b(ji,jj) = 0._wp 1371 END DO 1372 END DO 1085 1373 END IF 1086 1374 ! 1087 1375 za1 = 1._wp / REAL(Agrif_rhot(), wp) 1088 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 1089 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1376 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1377 DO jj = 1, jpj 1378 DO ji = 1, jpi 1379 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * ub2_b(ji,jj) 1380 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * vb2_b(ji,jj) 1381 END DO 1382 END DO 1090 1383 ENDIF 1091 1384 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7646 r7698 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji 99 100 ! 100 101 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 109 110 CASE ( np_ENE ) !* energy conserving scheme 110 111 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 112 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 113 DO jk = 1, jpk 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 117 ztrdv(ji,jj,jk) = va(ji,jj,jk) 118 END DO 119 END DO 120 END DO 113 121 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 122 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 123 DO jk = 1, jpk 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 127 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 128 END DO 129 END DO 130 END DO 116 131 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 132 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 133 DO jk = 1, jpk 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 137 ztrdv(ji,jj,jk) = va(ji,jj,jk) 138 END DO 139 END DO 140 END DO 119 141 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 142 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 143 DO jk = 1, jpk 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 147 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 148 END DO 149 END DO 150 END DO 122 151 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 123 152 ELSE ! total vorticity trend … … 128 157 CASE ( np_ENS ) !* enstrophy conserving scheme 129 158 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 164 ztrdv(ji,jj,jk) = va(ji,jj,jk) 165 END DO 166 END DO 167 END DO 132 168 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 169 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 170 DO jk = 1, jpk 171 DO jj = 1, jpj 172 DO ji = 1, jpi 173 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 174 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 175 END DO 176 END DO 177 END DO 135 178 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 179 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 180 DO jk = 1, jpk 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 184 ztrdv(ji,jj,jk) = va(ji,jj,jk) 185 END DO 186 END DO 187 END DO 138 188 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 189 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 190 DO jk = 1, jpk 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 194 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 195 END DO 196 END DO 197 END DO 141 198 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 142 199 ELSE ! total vorticity trend … … 147 204 CASE ( np_MIX ) !* mixed ene-ens scheme 148 205 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 206 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 207 DO jk = 1, jpk 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 211 ztrdv(ji,jj,jk) = va(ji,jj,jk) 212 END DO 213 END DO 214 END DO 151 215 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 216 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 217 DO jk = 1, jpk 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 221 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 222 END DO 223 END DO 224 END DO 154 225 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 227 DO jk = 1, jpk 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 231 ztrdv(ji,jj,jk) = va(ji,jj,jk) 232 END DO 233 END DO 234 END DO 157 235 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 236 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 237 DO jk = 1, jpk 238 DO jj = 1, jpj 239 DO ji = 1, jpi 240 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 241 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 242 END DO 243 END DO 244 END DO 160 245 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 161 246 ELSE ! total vorticity trend … … 167 252 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 168 253 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 254 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 255 DO jk = 1, jpk 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 259 ztrdv(ji,jj,jk) = va(ji,jj,jk) 260 END DO 261 END DO 262 END DO 171 263 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 264 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 265 DO jk = 1, jpk 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 269 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 270 END DO 271 END DO 272 END DO 174 273 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 274 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 275 DO jk = 1, jpk 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 279 ztrdv(ji,jj,jk) = va(ji,jj,jk) 280 END DO 281 END DO 282 END DO 177 283 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 284 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 285 DO jk = 1, jpk 286 DO jj = 1, jpj 287 DO ji = 1, jpi 288 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 289 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 290 END DO 291 END DO 292 END DO 180 293 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 181 294 ELSE ! total vorticity trend … … 244 357 SELECT CASE( kvor ) !== vorticity considered ==! 245 358 CASE ( np_COR ) !* Coriolis (planetary vorticity) 246 zwz(:,:) = ff_f(:,:) 359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 zwz(ji,jj) = ff_f(ji,jj) 363 END DO 364 END DO 247 365 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 248 367 DO jj = 1, jpjm1 249 368 DO ji = 1, fs_jpim1 ! vector opt. … … 253 372 END DO 254 373 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji) 255 375 DO jj = 1, jpjm1 256 376 DO ji = 1, fs_jpim1 ! vector opt. … … 261 381 END DO 262 382 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 263 384 DO jj = 1, jpjm1 264 385 DO ji = 1, fs_jpim1 ! vector opt. … … 269 390 END DO 270 391 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 271 393 DO jj = 1, jpjm1 272 394 DO ji = 1, fs_jpim1 ! vector opt. … … 282 404 ! 283 405 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji) 284 407 DO jj = 1, jpjm1 285 408 DO ji = 1, fs_jpim1 ! vector opt. … … 290 413 291 414 IF( ln_sco ) THEN 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 zwz(ji,jj) = zwz(ji,jj) / e3f_n(ji,jj,jk) 419 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 420 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 421 END DO 422 END DO 295 423 ELSE 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zwx(ji,jj) = e2u(ji,jj) * pun(ji,jj,jk) 428 zwy(ji,jj) = e1v(ji,jj) * pvn(ji,jj,jk) 429 END DO 430 END DO 298 431 ENDIF 299 432 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2) 300 434 DO jj = 2, jpjm1 301 435 DO ji = fs_2, fs_jpim1 ! vector opt. … … 487 621 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 488 622 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3) 489 624 DO jj = 1, jpjm1 490 625 DO ji = 1, fs_jpim1 ! vector opt. … … 497 632 END DO 498 633 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3,zmsk) 499 635 DO jj = 1, jpjm1 500 636 DO ji = 1, fs_jpim1 ! vector opt. … … 512 648 SELECT CASE( kvor ) !== vorticity considered ==! 513 649 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji) 514 651 DO jj = 1, jpjm1 515 652 DO ji = 1, fs_jpim1 ! vector opt. … … 518 655 END DO 519 656 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji) 520 658 DO jj = 1, jpjm1 521 659 DO ji = 1, fs_jpim1 ! vector opt. … … 526 664 END DO 527 665 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji) 528 667 DO jj = 1, jpjm1 529 668 DO ji = 1, fs_jpim1 ! vector opt. … … 534 673 END DO 535 674 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji) 536 676 DO jj = 1, jpjm1 537 677 DO ji = 1, fs_jpim1 ! vector opt. … … 542 682 END DO 543 683 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji) 544 685 DO jj = 1, jpjm1 545 686 DO ji = 1, fs_jpim1 ! vector opt. … … 555 696 ! 556 697 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji) 557 699 DO jj = 1, jpjm1 558 700 DO ji = 1, fs_jpim1 ! vector opt. … … 565 707 ! 566 708 ! !== horizontal fluxes ==! 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 709 !$OMP PARALLEL DO schedule(static) private(jj,ji) 710 DO jj = 1, jpj 711 DO ji = 1, jpi 712 zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 713 zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 714 END DO 715 END DO 569 716 570 717 ! !== compute and add the vorticity term trend =! 571 718 jj = 2 572 719 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 573 721 DO ji = 2, jpi ! split in 2 parts due to vector opt. 574 722 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 577 725 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 578 726 END DO 727 !$OMP PARALLEL 728 !$OMP DO schedule(static) private(jj,ji) 579 729 DO jj = 3, jpj 580 730 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 585 735 END DO 586 736 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva) 587 738 DO jj = 2, jpjm1 588 739 DO ji = fs_2, fs_jpim1 ! vector opt. … … 595 746 END DO 596 747 END DO 748 !$OMP END PARALLEL 597 749 ! ! =============== 598 750 END DO ! End of slab … … 649 801 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 650 802 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 803 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 651 804 DO jk = 1, jpk 652 805 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r6140 r7698 77 77 IF( l_trddyn ) THEN ! Save ua and va trends 78 78 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 79 ztrdu(:,:,:) = ua(:,:,:) 80 ztrdv(:,:,:) = va(:,:,:) 79 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 80 DO jk = 1, jpk 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 84 ztrdv(ji,jj,jk) = va(ji,jj,jk) 85 END DO 86 END DO 87 END DO 81 88 ENDIF 82 89 90 !$OMP PARALLEL 83 91 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 92 !$OMP DO schedule(static) private(jj, ji) 84 93 DO jj = 2, jpj ! vertical fluxes 85 94 DO ji = fs_2, jpi ! vector opt. … … 87 96 END DO 88 97 END DO 98 !$OMP DO schedule(static) private(jj, ji) 89 99 DO jj = 2, jpjm1 ! vertical momentum advection at w-point 90 100 DO ji = fs_2, fs_jpim1 ! vector opt. … … 94 104 END DO 95 105 END DO 106 !$OMP END PARALLEL 96 107 ! 97 108 ! Surface and bottom advective fluxes set to zero 98 109 IF ( ln_isfcav ) THEN 110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 99 111 DO jj = 2, jpjm1 100 112 DO ji = fs_2, fs_jpim1 ! vector opt. … … 106 118 END DO 107 119 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jj, ji) 108 121 DO jj = 2, jpjm1 109 122 DO ji = fs_2, fs_jpim1 ! vector opt. … … 116 129 END IF 117 130 131 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 118 132 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points 119 133 DO jj = 2, jpjm1 … … 130 144 131 145 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 132 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 133 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 147 DO jk = 1, jpk 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 151 ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 152 END DO 153 END DO 154 END DO 134 155 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 135 156 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7646 r7698 53 53 !! 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER :: ji, jj, jk ! dummy loop indices 55 56 ! 56 57 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 66 67 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 67 68 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 68 ztrdu(:,:,:) = ua(:,:,:) 69 ztrdv(:,:,:) = va(:,:,:) 69 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 70 DO jk = 1, jpk 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 74 ztrdv(ji,jj,jk) = va(ji,jj,jk) 75 END DO 76 END DO 77 END DO 70 78 ENDIF 71 79 … … 78 86 79 87 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 80 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 81 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 88 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 89 DO jk = 1, jpk 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 ztrdu(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / r2dt - ztrdu(ji,jj,jk) 93 ztrdv(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / r2dt - ztrdv(ji,jj,jk) 94 END DO 95 END DO 96 END DO 82 97 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 83 98 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r6752 r7698 92 92 ! 93 93 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 94 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 94 95 DO jk = 1, jpkm1 95 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 96 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 ua(ji,jj,jk) = ( ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk) 99 va(ji,jj,jk) = ( vb(ji,jj,jk) + p2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk) 100 END DO 101 END DO 97 102 END DO 98 103 ELSE ! applied on thickness weighted velocity 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 99 105 DO jk = 1, jpkm1 100 ua(:,:,jk) = ( e3u_b(:,:,jk) * ub(:,:,jk) & 101 & + p2dt * e3u_n(:,:,jk) * ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 102 va(:,:,jk) = ( e3v_b(:,:,jk) * vb(:,:,jk) & 103 & + p2dt * e3v_n(:,:,jk) * va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ua(ji,jj,jk) = ( e3u_b(ji,jj,jk) * ub(ji,jj,jk) & 109 & + p2dt * e3u_n(ji,jj,jk) * ua(ji,jj,jk) ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 110 va(ji,jj,jk) = ( e3v_b(ji,jj,jk) * vb(ji,jj,jk) & 111 & + p2dt * e3v_n(ji,jj,jk) * va(ji,jj,jk) ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 112 END DO 113 END DO 104 114 END DO 105 115 ENDIF … … 112 122 ! 113 123 IF( ln_bfrimp ) THEN 124 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 114 125 DO jj = 2, jpjm1 115 126 DO ji = 2, jpim1 … … 121 132 END DO 122 133 IF ( ln_isfcav ) THEN 134 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 123 135 DO jj = 2, jpjm1 124 136 DO ji = 2, jpim1 … … 138 150 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 139 151 IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 152 !$OMP PARALLEL 153 !$OMP DO schedule(static) private(jk,jj,ji) 140 154 DO jk = 1, jpkm1 ! remove barotropic velocities 141 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 142 va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 143 END DO 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ua_b(ji,jj) ) * umask(ji,jj,jk) 158 va(ji,jj,jk) = ( va(ji,jj,jk) - va_b(ji,jj) ) * vmask(ji,jj,jk) 159 END DO 160 END DO 161 END DO 162 !$OMP DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 144 163 DO jj = 2, jpjm1 ! Add bottom/top stress due to barotropic component only 145 164 DO ji = fs_2, fs_jpim1 ! vector opt. … … 152 171 END DO 153 172 END DO 173 !$OMP END DO NOWAIT 174 !$OMP END PARALLEL 154 175 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 155 177 DO jj = 2, jpjm1 156 178 DO ji = fs_2, fs_jpim1 ! vector opt. … … 172 194 ! non zero value at the ocean bottom depending on the bottom friction used. 173 195 ! 196 !$OMP PARALLEL 197 !$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws) 174 198 DO jk = 1, jpkm1 ! Matrix 175 199 DO jj = 2, jpjm1 … … 184 208 END DO 185 209 END DO 210 !$OMP DO schedule(static) private(jj, ji) 186 211 DO jj = 2, jpjm1 ! Surface boundary conditions 187 212 DO ji = fs_2, fs_jpim1 ! vector opt. … … 207 232 ! 208 233 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 234 !$OMP DO schedule(static) private(jj, ji) 209 235 DO jj = 2, jpjm1 210 236 DO ji = fs_2, fs_jpim1 ! vector opt. … … 212 238 END DO 213 239 END DO 214 END DO 215 ! 240 !$OMP END DO NOWAIT 241 END DO 242 ! 243 !$OMP DO schedule(static) private(jj, ji, ze3ua) 216 244 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 217 245 DO ji = fs_2, fs_jpim1 ! vector opt. … … 222 250 END DO 223 251 DO jk = 2, jpkm1 252 !$OMP DO schedule(static) private(jj, ji) 224 253 DO jj = 2, jpjm1 225 254 DO ji = fs_2, fs_jpim1 … … 229 258 END DO 230 259 ! 260 !$OMP DO schedule(static) private(jj, ji) 231 261 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 232 262 DO ji = fs_2, fs_jpim1 ! vector opt. … … 235 265 END DO 236 266 DO jk = jpk-2, 1, -1 267 !$OMP DO schedule(static) private(jj, ji) 237 268 DO jj = 2, jpjm1 238 269 DO ji = fs_2, fs_jpim1 … … 248 279 ! non zero value at the ocean bottom depending on the bottom friction used 249 280 ! 281 !$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws) 250 282 DO jk = 1, jpkm1 ! Matrix 251 283 DO jj = 2, jpjm1 … … 260 292 END DO 261 293 END DO 294 !$OMP DO schedule(static) private(jj, ji) 262 295 DO jj = 2, jpjm1 ! Surface boundary conditions 263 296 DO ji = fs_2, fs_jpim1 ! vector opt. … … 283 316 ! 284 317 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 318 !$OMP DO schedule(static) private(jj, ji) 285 319 DO jj = 2, jpjm1 286 320 DO ji = fs_2, fs_jpim1 ! vector opt. … … 288 322 END DO 289 323 END DO 290 END DO 291 ! 324 !$OMP END DO NOWAIT 325 END DO 326 ! 327 !$OMP DO schedule(static) private(jj, ji, ze3va) 292 328 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 293 329 DO ji = fs_2, fs_jpim1 ! vector opt. … … 298 334 END DO 299 335 DO jk = 2, jpkm1 336 !$OMP DO schedule(static) private(jj, ji) 300 337 DO jj = 2, jpjm1 301 338 DO ji = fs_2, fs_jpim1 ! vector opt. … … 305 342 END DO 306 343 ! 344 !$OMP DO schedule(static) private(jj, ji) 307 345 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 308 346 DO ji = fs_2, fs_jpim1 ! vector opt. … … 311 349 END DO 312 350 DO jk = jpk-2, 1, -1 351 !$OMP DO schedule(static) private(jj, ji) 313 352 DO jj = 2, jpjm1 314 353 DO ji = fs_2, fs_jpim1 … … 316 355 END DO 317 356 END DO 318 END DO 357 !$OMP END DO NOWAIT 358 END DO 359 !$OMP END PARALLEL 319 360 320 361 ! J. Chanut: Lines below are useless ? … … 322 363 !!gm I almost sure it is !!!! 323 364 IF( ln_bfrimp ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 324 366 DO jj = 2, jpjm1 325 367 DO ji = 2, jpim1 … … 331 373 END DO 332 374 IF (ln_isfcav) THEN 375 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 333 376 DO jj = 2, jpjm1 334 377 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7646 r7698 72 72 INTEGER, INTENT(in) :: kt ! time step 73 73 ! 74 INTEGER :: jk ! dummy loop indice74 INTEGER :: jk, jj, ji ! dummy loop indice 75 75 REAL(wp) :: z2dt, zcoef ! local scalars 76 76 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv ! 2D workspace … … 95 95 ! !------------------------------! 96 96 IF(ln_wd) THEN 97 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 98 ENDIF 99 100 CALL div_hor( kt ) ! Horizontal divergence 101 ! 102 zhdiv(:,:) = 0._wp 97 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 98 END IF 99 100 CALL div_hor( kt ) ! Horizontal divergence 101 ! 102 !$OMP PARALLEL 103 !$OMP DO schedule(static) private(jj, ji) 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 zhdiv(ji,jj) = 0._wp 107 END DO 108 END DO 103 109 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 104 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 110 !$OMP DO schedule(static) private(jj, ji) 111 DO jj = 1, jpj 112 DO ji = 1, jpi 113 zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 114 END DO 115 END DO 105 116 END DO 106 117 ! ! Sea surface elevation time stepping … … 108 119 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 109 120 ! 110 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 111 121 !$OMP DO schedule(static) private(jj, ji) 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 ssha(ji,jj) = ( sshb(ji,jj) - z2dt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 125 END DO 126 END DO 127 !$OMP END PARALLEL 112 128 IF ( .NOT.ln_dynspg_ts ) THEN 113 129 ! These lines are not necessary with time splitting since … … 125 141 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 126 142 CALL ssh_asm_inc( kt ) 127 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 143 !$OMP PARALLEL DO schedule(static) private(jj, ji) 144 DO jj = 1, jpj 145 DO ji = 1, jpi 146 ssha(ji,jj) = ssha(ji,jj) + z2dt * ssh_iau(ji,jj) 147 END DO 148 END DO 128 149 ENDIF 129 150 #endif … … 171 192 IF(lwp) WRITE(numout,*) '~~~~~ ' 172 193 ! 173 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 194 !$OMP PARALLEL DO schedule(static) private(jj, ji) 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 wn(ji,jj,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 198 END DO 199 END DO 174 200 ENDIF 175 201 ! !------------------------------! … … 181 207 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 182 208 CALL wrk_alloc( jpi, jpj, jpk, zhdiv ) 209 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 183 210 ! 184 211 DO jk = 1, jpkm1 … … 196 223 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 197 224 ! computation of w 198 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 199 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 226 DO jj = 1, jpj 227 DO ji = 1, jpi ! vector opt. 228 wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) + zhdiv(ji,jj,jk) & 229 & + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) ) ) * tmask(ji,jj,jk) 230 END DO 231 END DO 200 232 END DO 201 233 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 203 235 ELSE ! z_star and linear free surface cases 204 236 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 205 ! computation of w 206 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) & 207 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 237 !$OMP PARALLEL DO schedule(static) private(jj, ji) 238 DO jj = 1, jpj 239 DO ji = 1, jpi ! vector opt. 240 ! computation of w 241 wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) & 242 & + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) ) ) * tmask(ji,jj,jk) 243 END DO 244 END DO 208 245 END DO 209 246 ENDIF 210 247 211 248 IF( ln_bdy ) THEN 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 212 250 DO jk = 1, jpkm1 213 wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 251 DO jj = 1, jpj 252 DO ji = 1, jpi 253 wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj) 254 END DO 255 END DO 214 256 END DO 215 257 ENDIF … … 241 283 INTEGER, INTENT(in) :: kt ! ocean time-step index 242 284 ! 285 INTEGER :: ji, jj, jk ! dummy loop indices 243 286 REAL(wp) :: zcoef ! local scalar 244 287 !!---------------------------------------------------------------------- … … 254 297 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 255 298 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 299 !$OMP PARALLEL DO schedule(static) private(jj, ji) 300 DO jj = 1, jpj 301 DO ji = 1, jpi 302 sshb(ji,jj) = sshn(ji,jj) ! before <-- now 303 sshn(ji,jj) = ssha(ji,jj) ! now <-- after (before already = now) 304 END DO 305 END DO 258 306 ! 259 307 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 260 308 ! ! before <-- now filtered 261 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 309 !$OMP PARALLEL DO schedule(static) private(jj, ji) 310 DO jj = 1, jpj 311 DO ji = 1, jpi 312 sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 313 END DO 314 END DO 262 315 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 263 316 zcoef = atfp * rdt * r1_rau0 264 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 265 & - rnf_b(:,:) + rnf (:,:) & 266 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 317 !$OMP PARALLEL DO schedule(static) private(jj, ji) 318 DO jj = 1, jpj 319 DO ji = 1, jpi 320 sshb(ji,jj) = sshb(ji,jj) - zcoef * ( emp_b(ji,jj) - emp (ji,jj) & 321 & - rnf_b(ji,jj) + rnf (ji,jj) & 322 & + fwfisf_b(ji,jj) - fwfisf(ji,jj) ) * ssmask(ji,jj) 323 END DO 324 END DO 267 325 ENDIF 268 sshn(:,:) = ssha(:,:) ! now <-- after 326 !$OMP PARALLEL DO schedule(static) private(jj, ji) 327 DO jj = 1, jpj 328 DO ji = 1, jpi 329 sshn(ji,jj) = ssha(ji,jj) ! now <-- after 330 END DO 331 END DO 269 332 ENDIF 270 333 !
Note: See TracChangeset
for help on using the changeset viewer.
