Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN
- Timestamp:
- 2017-03-03T12:46:59+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
r7698 r7753 72 72 ENDIF 73 73 ! 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)75 74 DO jk = 1, jpkm1 !== Horizontal divergence ==! 76 75 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r7698 r7753 47 47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 48 !! 49 INTEGER :: j k, ji, jj ! dummy loop indexes49 INTEGER :: 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 !$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 67 ztrdu(:,:,:) = ua(:,:,:) 68 ztrdv(:,:,:) = va(:,:,:) 76 69 ENDIF 77 70 78 71 79 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)80 72 DO jj = 2, jpjm1 81 73 DO ji = 2, jpim1 … … 90 82 ! 91 83 IF( ln_isfcav ) THEN ! ocean cavities 92 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)93 84 DO jj = 2, jpjm1 94 85 DO ji = 2, jpim1 … … 108 99 ! 109 100 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 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 101 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 102 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 119 103 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 120 104 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7698 r7753 84 84 !!---------------------------------------------------------------------- 85 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 INTEGER :: jk, jj, ji87 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 88 87 !!---------------------------------------------------------------------- … … 92 91 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) 93 92 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 93 ztrdu(:,:,:) = ua(:,:,:) 94 ztrdv(:,:,:) = va(:,:,:) 103 95 ENDIF 104 96 ! … … 113 105 ! 114 106 IF( l_trddyn ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 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 107 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 124 109 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 125 110 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) … … 213 198 ! 214 199 ! initialisation of ice shelf load 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 200 IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 223 201 IF ( ln_isfcav ) THEN 224 202 CALL wrk_alloc( jpi,jpj, 2, ztstop) … … 234 212 235 213 ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 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 214 ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 243 215 244 216 ! compute density of the water displaced by the ice shelf … … 254 226 ! divided by 2 later 255 227 ziceload = 0._wp 256 !$OMP PARALLEL257 !$OMP DO schedule(static) private(jj,ji,ikt,jk)258 228 DO jj = 1, jpj 259 229 DO ji = 1, jpi … … 268 238 END DO 269 239 END DO 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 240 riceload(:,:)=ziceload(:,:) ! need to be saved for diaar5 277 241 278 242 CALL wrk_dealloc( jpi,jpj, 2, ztstop) … … 318 282 319 283 ! Surface value 320 !$OMP PARALLEL321 !$OMP DO schedule(static) private(ji,jj, zcoef1)322 284 DO jj = 2, jpjm1 323 285 DO ji = fs_2, fs_jpim1 ! vector opt. … … 335 297 ! interior value (2=<jk=<jpkm1) 336 298 DO jk = 2, jpkm1 337 !$OMP DO schedule(static) private(ji,jj, zcoef1)338 299 DO jj = 2, jpjm1 339 300 DO ji = fs_2, fs_jpim1 ! vector opt. … … 352 313 END DO 353 314 END DO 354 !$OMP END DO NOWAIT 355 END DO 356 !$OMP END PARALLEL 315 END DO 357 316 ! 358 317 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) … … 392 351 393 352 ! Surface value (also valid in partial step case) 394 !$OMP PARALLEL395 !$OMP DO schedule(static) private(ji,jj,zcoef1)396 353 DO jj = 2, jpjm1 397 354 DO ji = fs_2, fs_jpim1 ! vector opt. … … 408 365 ! interior value (2=<jk=<jpkm1) 409 366 DO jk = 2, jpkm1 410 !$OMP DO schedule(static) private(ji,jj, zcoef1)411 367 DO jj = 2, jpjm1 412 368 DO ji = fs_2, fs_jpim1 ! vector opt. … … 428 384 429 385 ! 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)431 386 DO jj = 2, jpjm1 432 387 DO ji = 2, jpim1 … … 449 404 END DO 450 405 END DO 451 !$OMP END PARALLEL452 406 ! 453 407 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7698 r7753 96 96 IF( l_trddyn ) THEN ! Save ua and va trends 97 97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 98 ztrdu(:,:,:) = ua(:,:,:) 99 ztrdv(:,:,:) = va(:,:,:) 107 100 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 101 102 zhke(:,:,jpk) = 0._wp 114 103 115 104 IF (ln_bdy) THEN … … 144 133 ! 145 134 CASE ( nkeg_C2 ) !-- Standard scheme --! 146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv)147 135 DO jk = 1, jpkm1 148 136 DO jj = 2, jpj … … 158 146 ! 159 147 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv)161 148 DO jk = 1, jpkm1 162 149 DO jj = 2, jpjm1 … … 181 168 IF (ln_bdy) THEN 182 169 ! restore velocity masks at points outside boundary 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) 170 un(:,:,:) = un(:,:,:) * umask(:,:,:) 171 vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 172 ENDIF 173 174 175 ! 196 176 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! 197 177 DO jj = 2, jpjm1 … … 204 184 ! 205 185 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 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 186 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 187 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 215 188 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 216 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7698 r7753 61 61 !!---------------------------------------------------------------------- 62 62 INTEGER, INTENT(in) :: kt ! ocean time-step index 63 INTEGER :: jk, jj, ji64 63 ! 65 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 70 69 IF( l_trddyn ) THEN ! temporary save of momentum trends 71 70 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 71 ztrdu(:,:,:) = ua(:,:,:) 72 ztrdv(:,:,:) = va(:,:,:) 81 73 ENDIF 82 74 … … 90 82 91 83 IF( l_trddyn ) THEN ! save the horizontal diffusive trends for further diagnostics 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 84 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 85 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 101 86 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 102 87 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r7698 r7753 75 75 ! 76 76 ! ! =============== 77 !$OMP PARALLEL78 77 DO jk = 1, jpkm1 ! Horizontal slab 79 78 ! ! =============== 80 !$OMP DO schedule(static) private(jj, ji)81 79 DO jj = 2, jpj 82 80 DO ji = fs_2, jpi ! vector opt. … … 95 93 END DO 96 94 ! 97 !$OMP DO schedule(static) private(jj, ji)98 95 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 99 96 DO ji = fs_2, fs_jpim1 ! vector opt. … … 109 106 ! ! =============== 110 107 END DO ! End of slab 111 !$OMP END PARALLEL112 108 ! ! =============== 113 109 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) … … 132 128 !!---------------------------------------------------------------------- 133 129 INTEGER , INTENT(in ) :: kt ! ocean time-step index 134 INTEGER :: jk, jj, ji135 130 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 136 131 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend … … 149 144 ENDIF 150 145 ! 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 146 zulap(:,:,:) = 0._wp 147 zvlap(:,:,:) = 0._wp 160 148 ! 161 149 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
r7698 r7753 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 !$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 117 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 118 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 119 DO jk = 2, jpkm1 120 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 121 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 124 122 END DO 125 DO jk = 2, jpkm1 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 123 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) 133 126 END DO 134 !$OMP DO schedule(static) private(jk,jj,ji)135 DO jk = 1, jpkm1136 DO jj = 1, jpj137 DO ji = 1, jpi138 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 DO141 END DO142 END DO143 !$OMP END PARALLEL144 127 ! 145 128 IF( .NOT.ln_bt_fw ) THEN … … 148 131 ! In the forward case, this is done below after asselin filtering 149 132 ! so that asselin contribution is removed at the same time 150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)151 133 DO jk = 1, jpkm1 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 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 160 137 ENDIF 161 138 ENDIF … … 184 161 ! 185 162 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 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 163 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 164 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 195 165 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 196 166 CALL iom_put( "vtrd_tot", zva ) 197 167 ENDIF 198 168 ! 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 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) 209 172 ENDIF 210 173 … … 212 175 ! ------------------------------------------ 213 176 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 214 !$OMP PARALLEL215 !$OMP DO schedule(static) private(jk,jj,ji)216 177 DO jk = 1, jpkm1 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 178 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 179 vn(:,:,jk) = va(:,:,jk) 180 END DO 181 IF(.NOT.ln_linssh ) THEN 182 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) 222 186 END DO 223 END DO 224 !$OMP END DO NOWAIT 225 IF(.NOT.ln_linssh ) THEN 226 !$OMP DO schedule(static) private(jk,jj,ji) 227 DO jk = 1, jpkm1 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 235 END DO 236 ENDIF 237 !$OMP END PARALLEL 187 ENDIF 238 188 ELSE !* Leap-Frog : Asselin filter and swap 239 189 ! ! =============! 240 190 IF( ln_linssh ) THEN ! Fixed volume ! 241 191 ! ! =============! 242 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf)243 192 DO jk = 1, jpkm1 244 193 DO jj = 1, jpj … … 261 210 ! ---------------------------------------------------- 262 211 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 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 212 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 269 213 ELSE 270 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)271 214 DO jk = 1, jpkm1 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 215 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 277 216 END DO 278 217 ! Add volume filter correction: compatibility with tracer advection scheme … … 280 219 zcoef = atfp * rdt * r1_rau0 281 220 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 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 221 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 222 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 289 223 ELSE ! if ice shelf melting 290 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt)291 224 DO jj = 1, jpj 292 225 DO ji = 1, jpi … … 304 237 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 305 238 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 306 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf)307 239 DO jk = 1, jpkm1 308 240 DO jj = 1, jpj … … 325 257 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 326 258 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 327 !$OMP PARALLEL328 !$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf)329 259 DO jk = 1, jpkm1 330 260 DO jj = 1, jpj … … 347 277 END DO 348 278 END DO 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 279 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 280 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 357 281 ! 358 282 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) … … 364 288 ! Revert "before" velocities to time split estimate 365 289 ! Doing it here also means that asselin filter contribution is removed 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 290 zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 291 zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 292 DO jk = 2, jpkm1 293 zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 294 zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 373 295 END DO 374 DO jk = 2, jpkm1 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 296 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) 382 299 END DO 383 !$OMP DO schedule(static) private(jk,jj,ji)384 DO jk = 1, jpkm1385 DO jj = 1, jpj386 DO ji = 1, jpi387 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 DO390 END DO391 END DO392 !$OMP END PARALLEL393 300 ENDIF 394 301 ! … … 401 308 ! 402 309 IF(.NOT.ln_linssh ) THEN 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 310 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 311 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 312 DO jk = 2, jpkm1 313 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 314 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 410 315 END DO 411 DO jk = 2, jpkm1 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 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) 324 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) 439 329 END DO 440 DO jk = 2, jpkm1 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 450 END DO 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 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(:,:) 461 334 ! 462 335 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 465 338 ENDIF 466 339 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 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 340 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 341 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 476 342 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 477 343 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7698 r7753 83 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 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 85 ztrdu(:,:,:) = ua(:,:,:) 86 ztrdv(:,:,:) = va(:,:,:) 94 87 ENDIF 95 88 ! … … 98 91 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 99 92 ! 100 !$OMP PARALLEL DO schedule(static) private(jj, ji)101 93 DO jj = 2, jpjm1 102 94 DO ji = fs_2, fs_jpim1 ! vector opt. … … 108 100 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 109 101 zg_2 = grav * 0.5 110 !$OMP PARALLEL DO schedule(static) private(jj, ji)111 102 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh 112 103 DO ji = fs_2, fs_jpim1 ! vector opt. … … 124 115 CALL upd_tide( kt ) ! update tide potential 125 116 ! 126 !$OMP PARALLEL DO schedule(static) private(jj, ji)127 117 DO jj = 2, jpjm1 ! add tide potential forcing 128 118 DO ji = fs_2, fs_jpim1 ! vector opt. … … 138 128 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 139 129 zgrau0r = - grav * r1_rau0 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) 130 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 148 131 DO jj = 2, jpjm1 149 132 DO ji = fs_2, fs_jpim1 ! vector opt. … … 152 135 END DO 153 136 END DO 154 !$OMP END PARALLEL155 137 ! 156 138 CALL wrk_dealloc( jpi,jpj, zpice ) 157 139 ENDIF 158 140 ! 159 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)160 141 DO jk = 1, jpkm1 !== Add all terms to the general trend 161 142 DO jj = 2, jpjm1 … … 177 158 ! 178 159 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 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 160 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 188 162 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 189 163 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7698 r7753 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)226 225 DO jj = 1, jpjm1 227 226 DO ji = 1, jpim1 … … 232 231 END DO 233 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 234 !$OMP PARALLEL DO schedule(static) private(jj, ji)235 233 DO jj = 1, jpjm1 236 234 DO ji = 1, jpim1 … … 245 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 246 244 ! 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) 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 253 246 DO jj = 2, jpj 254 247 DO ji = 2, jpi … … 259 252 END DO 260 253 END DO 261 !$OMP END PARALLEL262 254 ! 263 255 ELSE !== all other schemes (ENE, ENS, MIX) 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 256 zwz(:,:) = 0._wp 257 zhf(:,:) = 0._wp 271 258 272 259 !!gm assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed … … 288 275 ELSE 289 276 !zhf(:,:) = hbatf(:,:) 290 !$OMP PARALLEL DO schedule(static) private(ji,jj)291 277 DO jj = 1, jpjm1 292 278 DO ji = 1, jpim1 … … 303 289 END IF 304 290 305 !$OMP PARALLEL306 !$OMP DO schedule(static) private(ji,jj)307 291 DO jj = 1, jpjm1 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 292 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 311 293 END DO 312 294 !!gm end 313 295 314 296 DO jk = 1, jpkm1 315 !$OMP DO schedule(static) private(ji,jj)316 297 DO jj = 1, jpjm1 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 298 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 299 END DO 300 END DO 323 301 CALL lbc_lnk( zhf, 'F', 1._wp ) 324 302 ! JC: TBC. hf should be greater than 0 325 !$OMP PARALLEL326 !$OMP DO schedule(static) private(jj, ji)327 303 DO jj = 1, jpj 328 304 DO ji = 1, jpi … … 330 306 END DO 331 307 END DO 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 308 zwz(:,:) = ff_f(:,:) * zwz(:,:) 339 309 ENDIF 340 310 ENDIF … … 354 324 ! !* e3*d/dt(Ua) (Vertically integrated) 355 325 ! ! -------------------------------------------------- 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 326 zu_frc(:,:) = 0._wp 327 zv_frc(:,:) = 0._wp 328 ! 329 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) 363 332 END DO 364 333 ! 365 DO jk = 1, jpkm1 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 373 END DO 374 ! 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 334 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 335 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 336 ! 382 337 ! 383 338 ! !* baroclinic momentum trend (remove the vertical mean trend) 384 !$OMP DO schedule(static) private(jk,jj,ji)385 339 DO jk = 1, jpkm1 ! ----------------------------------------------------------- 386 340 DO jj = 2, jpjm1 … … 391 345 END DO 392 346 END DO 393 !$OMP END DO NOWAIT394 347 395 348 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... … … 399 352 ! !* barotropic Coriolis trends (vorticity scheme dependent) 400 353 ! ! -------------------------------------------------------- 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 354 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 409 356 ! 410 357 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)412 358 DO jj = 2, jpjm1 413 359 DO ji = fs_2, fs_jpim1 ! vector opt. … … 423 369 ! 424 370 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1)426 371 DO jj = 2, jpjm1 427 372 DO ji = fs_2, fs_jpim1 ! vector opt. … … 436 381 ! 437 382 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 438 !$OMP PARALLEL DO schedule(static) private(jj,ji)439 383 DO jj = 2, jpjm1 440 384 DO ji = fs_2, fs_jpim1 ! vector opt. … … 456 400 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 457 401 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)459 402 DO jj = 2, jpjm1 460 403 DO ji = 2, jpim1 … … 497 440 END DO 498 441 499 !$OMP PARALLEL DO schedule(static) private(jj,ji)500 442 DO jj = 2, jpjm1 501 443 DO ji = 2, jpim1 … … 509 451 ELSE 510 452 511 !$OMP PARALLEL DO schedule(static) private(jj,ji)512 453 DO jj = 2, jpjm1 513 454 DO ji = fs_2, fs_jpim1 ! vector opt. … … 520 461 ENDIF 521 462 522 !$OMP PARALLEL DO schedule(static) private(jj,ji)523 463 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 524 464 DO ji = fs_2, fs_jpim1 … … 530 470 ! ! Add bottom stress contribution from baroclinic velocities: 531 471 IF (ln_bt_fw) THEN 532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)533 472 DO jj = 2, jpjm1 534 473 DO ji = fs_2, fs_jpim1 ! vector opt. … … 540 479 END DO 541 480 ELSE 542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)543 481 DO jj = 2, jpjm1 544 482 DO ji = fs_2, fs_jpim1 ! vector opt. … … 553 491 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 554 492 IF( ln_wd ) THEN 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 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(:,:) 562 495 ELSE 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 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 570 498 END IF 571 499 ! 572 500 ! ! Add top stress contribution from baroclinic velocities: 573 501 IF( ln_bt_fw ) THEN 574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)575 502 DO jj = 2, jpjm1 576 503 DO ji = fs_2, fs_jpim1 ! vector opt. … … 582 509 END DO 583 510 ELSE 584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)585 511 DO jj = 2, jpjm1 586 512 DO ji = fs_2, fs_jpim1 ! vector opt. … … 594 520 ! 595 521 ! Note that the "unclipped" top friction parameter is used even with explicit drag 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 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 603 524 ! 604 525 IF (ln_bt_fw) THEN ! Add wind forcing 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 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 612 528 ELSE 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 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(:,:) 620 531 ENDIF 621 532 ! 622 533 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 623 534 IF (ln_bt_fw) THEN 624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)625 535 DO jj = 2, jpjm1 626 536 DO ji = fs_2, fs_jpim1 ! vector opt. … … 632 542 END DO 633 543 ELSE 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)635 544 DO jj = 2, jpjm1 636 545 DO ji = fs_2, fs_jpim1 ! vector opt. … … 649 558 ! ! Surface net water flux and rivers 650 559 IF (ln_bt_fw) THEN 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 560 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 657 561 ELSE 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 562 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 563 & + fwfisf(:,:) + fwfisf_b(:,:) ) 665 564 ENDIF 666 565 ! 667 566 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 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 567 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 674 568 ENDIF 675 569 ! … … 677 571 ! ! Include the IAU weighted SSH increment 678 572 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 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 573 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 685 574 ENDIF 686 575 #endif … … 700 589 ! Initialize barotropic variables: 701 590 IF( ll_init )THEN 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 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 713 597 ENDIF 714 598 715 599 ! 716 600 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 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 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(:,:) 730 609 ELSE ! CENTRED integration: start from BEFORE fields 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 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(:,:) 744 618 ENDIF 745 619 ! … … 747 621 ! 748 622 ! Initialize sums: 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 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 759 628 ! ! ==================== ! 760 629 DO jn = 1, icycle ! sub-time-step loop ! … … 780 649 781 650 ! Extrapolate barotropic velocities at step jit+0.5: 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 651 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 652 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 789 653 790 654 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 791 655 ! ! ------------------ 792 656 ! Extrapolate Sea Level at step jit+0.5: 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 657 zsshp2_e(:,:) = za1 * sshn_e(:,:) + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 800 658 ! 801 !$OMP DO schedule(static) private(jj,ji)802 659 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 803 660 DO ji = 2, fs_jpim1 ! Vector opt. … … 810 667 END DO 811 668 END DO 812 !$OMP END PARALLEL813 669 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 814 670 ! 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 671 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 672 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 822 673 ELSE 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 674 zhup2_e (:,:) = hu_n(:,:) 675 zhvp2_e (:,:) = hv_n(:,:) 830 676 ENDIF 831 677 ! !* after ssh … … 834 680 ! considering fluxes below: 835 681 ! 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 682 zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 683 zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 844 684 ! 845 685 #if defined key_agrif … … 872 712 ! Sum over sub-time-steps to compute advective velocities 873 713 za2 = wgtbtp2(jn) 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 714 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 715 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 883 716 ! 884 717 ! Set next sea level: 885 !$OMP DO schedule(static) private(jj,ji)886 718 DO jj = 2, jpjm1 887 719 DO ji = fs_2, fs_jpim1 ! vector opt. … … 890 722 END DO 891 723 END DO 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 724 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 725 899 726 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 900 727 … … 907 734 ! Sea Surface Height at u-,v-points (vvl case only) 908 735 IF( .NOT.ln_linssh ) THEN 909 !$OMP PARALLEL DO schedule(static) private(jj,ji)910 736 DO jj = 2, jpjm1 911 737 DO ji = 2, jpim1 ! NO Vector Opt. … … 940 766 ENDIF 941 767 ! 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 768 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 769 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 949 770 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)951 771 DO jj = 2, jpjm1 952 772 DO ji = 2, jpim1 … … 993 813 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 994 814 ! 995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)996 815 DO jj = 2, jpjm1 997 816 DO ji = 2, jpim1 … … 1007 826 END DO 1008 827 1009 IF( ln_wd ) THEN1010 !$OMP PARALLEL DO schedule(static) private(jj,ji)1011 DO jj = 1, jpj1012 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 DO1016 END DO1017 END IF1018 828 ENDIF 1019 829 ! … … 1026 836 ! 1027 837 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)1029 838 DO jj = 2, jpjm1 1030 839 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1039 848 ! 1040 849 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)1042 850 DO jj = 2, jpjm1 1043 851 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1052 860 ! 1053 861 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 1054 !$OMP PARALLEL DO schedule(static) private(jj,ji)1055 862 DO jj = 2, jpjm1 1056 863 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1070 877 ! Add tidal astronomical forcing if defined 1071 878 IF ( ln_tide .AND. ln_tide_pot ) THEN 1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1073 879 DO jj = 2, jpjm1 1074 880 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1082 888 ! 1083 889 ! Add bottom stresses: 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 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(:,:) 1096 896 ! 1097 897 ! Surface pressure trend: 1098 898 1099 899 IF( ln_wd ) THEN 1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1101 900 DO jj = 2, jpjm1 1102 901 DO ji = 2, jpim1 … … 1109 908 END DO 1110 909 ELSE 1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1112 910 DO jj = 2, jpjm1 1113 911 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1124 922 ! Set next velocities: 1125 923 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 1126 !$OMP PARALLEL DO schedule(static) private(jj,ji)1127 924 DO jj = 2, jpjm1 1128 925 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1142 939 ! 1143 940 ELSE !* Flux form 1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra)1145 941 DO jj = 2, jpjm1 1146 942 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1173 969 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 1174 970 IF( ln_wd ) THEN 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 971 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 972 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 1182 973 ELSE 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 974 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 975 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1190 976 END IF 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 977 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 978 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 1198 979 ! 1199 980 ENDIF … … 1208 989 ! !* Swap 1209 990 ! ! ---- 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 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(:,:) 1226 1002 1227 1003 ! !* Sum over whole bt loop … … 1229 1005 za1 = wgtbtp1(jn) 1230 1006 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 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 1007 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 1008 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1238 1009 ELSE ! Sum transports 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 1010 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1011 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) 1246 1012 ENDIF 1247 1013 ! ! Sum sea level 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 1014 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1254 1015 ! ! ==================== ! 1255 1016 END DO ! end loop ! … … 1260 1021 ! 1261 1022 ! Set advection velocity correction: 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 1023 zwx(:,:) = un_adv(:,:) 1024 zwy(:,:) = vn_adv(:,:) 1269 1025 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 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 1026 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1027 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1277 1028 ELSE 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 1029 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1030 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1285 1031 END IF 1286 1032 1287 1033 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 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 1034 ub2_b(:,:) = zwx(:,:) 1035 vb2_b(:,:) = zwy(:,:) 1295 1036 ENDIF 1296 1037 ! 1297 1038 ! Update barotropic trend: 1298 1039 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1300 1040 DO jk=1,jpkm1 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 1041 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 1042 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 1307 1043 END DO 1308 1044 ELSE 1309 1045 ! At this stage, ssha has been corrected: compute new depths at velocity points 1310 !$OMP PARALLEL DO schedule(static) private(jj,ji)1311 1046 DO jj = 1, jpjm1 1312 1047 DO ji = 1, jpim1 ! NO Vector Opt. … … 1321 1056 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1322 1057 ! 1323 !$OMP PARALLEL1324 !$OMP DO schedule(static) private(jk,jj,ji)1325 1058 DO jk=1,jpkm1 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 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 1332 1061 END DO 1333 !$OMP END DO NOWAIT1334 1062 ! Save barotropic velocities not transport: 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) 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 ! 1346 1067 DO jk = 1, jpkm1 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 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 ! 1355 1072 END DO 1356 1073 ! … … 1364 1081 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1365 1082 IF( Agrif_NbStepint() == 0 ) THEN 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 1083 ub2_i_b(:,:) = 0._wp 1084 vb2_i_b(:,:) = 0._wp 1373 1085 END IF 1374 1086 ! 1375 1087 za1 = 1._wp / REAL(Agrif_rhot(), wp) 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 1088 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 1089 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1383 1090 ENDIF 1384 1091 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7698 r7753 97 97 !!---------------------------------------------------------------------- 98 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 INTEGER :: jk, jj, ji100 99 ! 101 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 110 109 CASE ( np_ENE ) !* energy conserving scheme 111 110 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 111 ztrdu(:,:,:) = ua(:,:,:) 112 ztrdv(:,:,:) = va(:,:,:) 121 113 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 131 116 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 117 ztrdu(:,:,:) = ua(:,:,:) 118 ztrdv(:,:,:) = va(:,:,:) 141 119 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 151 122 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 152 123 ELSE ! total vorticity trend … … 157 128 CASE ( np_ENS ) !* enstrophy conserving scheme 158 129 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 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 130 ztrdu(:,:,:) = ua(:,:,:) 131 ztrdv(:,:,:) = va(:,:,:) 168 132 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 178 135 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 136 ztrdu(:,:,:) = ua(:,:,:) 137 ztrdv(:,:,:) = va(:,:,:) 188 138 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 198 141 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 199 142 ELSE ! total vorticity trend … … 204 147 CASE ( np_MIX ) !* mixed ene-ens scheme 205 148 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 149 ztrdu(:,:,:) = ua(:,:,:) 150 ztrdv(:,:,:) = va(:,:,:) 215 151 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 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 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 225 154 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 155 ztrdu(:,:,:) = ua(:,:,:) 156 ztrdv(:,:,:) = va(:,:,:) 235 157 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 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 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 245 160 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 246 161 ELSE ! total vorticity trend … … 252 167 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 253 168 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 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 169 ztrdu(:,:,:) = ua(:,:,:) 170 ztrdv(:,:,:) = va(:,:,:) 263 171 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 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 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 273 174 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 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 175 ztrdu(:,:,:) = ua(:,:,:) 176 ztrdv(:,:,:) = va(:,:,:) 283 177 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 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 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 293 180 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 294 181 ELSE ! total vorticity trend … … 357 244 SELECT CASE( kvor ) !== vorticity considered ==! 358 245 CASE ( np_COR ) !* Coriolis (planetary vorticity) 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 246 zwz(:,:) = ff_f(:,:) 365 247 CASE ( np_RVO ) !* relative vorticity 366 !$OMP PARALLEL DO schedule(static) private(jj,ji)367 248 DO jj = 1, jpjm1 368 249 DO ji = 1, fs_jpim1 ! vector opt. … … 372 253 END DO 373 254 CASE ( np_MET ) !* metric term 374 !$OMP PARALLEL DO schedule(static) private(jj,ji)375 255 DO jj = 1, jpjm1 376 256 DO ji = 1, fs_jpim1 ! vector opt. … … 381 261 END DO 382 262 CASE ( np_CRV ) !* Coriolis + relative vorticity 383 !$OMP PARALLEL DO schedule(static) private(jj,ji)384 263 DO jj = 1, jpjm1 385 264 DO ji = 1, fs_jpim1 ! vector opt. … … 390 269 END DO 391 270 CASE ( np_CME ) !* Coriolis + metric 392 !$OMP PARALLEL DO schedule(static) private(jj,ji)393 271 DO jj = 1, jpjm1 394 272 DO ji = 1, fs_jpim1 ! vector opt. … … 404 282 ! 405 283 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 406 !$OMP PARALLEL DO schedule(static) private(jj,ji)407 284 DO jj = 1, jpjm1 408 285 DO ji = 1, fs_jpim1 ! vector opt. … … 413 290 414 291 IF( ln_sco ) THEN 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 292 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 293 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 294 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 423 295 ELSE 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 296 zwx(:,:) = e2u(:,:) * pun(:,:,jk) 297 zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 431 298 ENDIF 432 299 ! !== compute and add the vorticity term trend =! 433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2)434 300 DO jj = 2, jpjm1 435 301 DO ji = fs_2, fs_jpim1 ! vector opt. … … 621 487 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 622 488 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3)624 489 DO jj = 1, jpjm1 625 490 DO ji = 1, fs_jpim1 ! vector opt. … … 632 497 END DO 633 498 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)635 499 DO jj = 1, jpjm1 636 500 DO ji = 1, fs_jpim1 ! vector opt. … … 648 512 SELECT CASE( kvor ) !== vorticity considered ==! 649 513 CASE ( np_COR ) !* Coriolis (planetary vorticity) 650 !$OMP PARALLEL DO schedule(static) private(jj,ji)651 514 DO jj = 1, jpjm1 652 515 DO ji = 1, fs_jpim1 ! vector opt. … … 655 518 END DO 656 519 CASE ( np_RVO ) !* relative vorticity 657 !$OMP PARALLEL DO schedule(static) private(jj,ji)658 520 DO jj = 1, jpjm1 659 521 DO ji = 1, fs_jpim1 ! vector opt. … … 664 526 END DO 665 527 CASE ( np_MET ) !* metric term 666 !$OMP PARALLEL DO schedule(static) private(jj,ji)667 528 DO jj = 1, jpjm1 668 529 DO ji = 1, fs_jpim1 ! vector opt. … … 673 534 END DO 674 535 CASE ( np_CRV ) !* Coriolis + relative vorticity 675 !$OMP PARALLEL DO schedule(static) private(jj,ji)676 536 DO jj = 1, jpjm1 677 537 DO ji = 1, fs_jpim1 ! vector opt. … … 682 542 END DO 683 543 CASE ( np_CME ) !* Coriolis + metric 684 !$OMP PARALLEL DO schedule(static) private(jj,ji)685 544 DO jj = 1, jpjm1 686 545 DO ji = 1, fs_jpim1 ! vector opt. … … 696 555 ! 697 556 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 698 !$OMP PARALLEL DO schedule(static) private(jj,ji)699 557 DO jj = 1, jpjm1 700 558 DO ji = 1, fs_jpim1 ! vector opt. … … 707 565 ! 708 566 ! !== horizontal fluxes ==! 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 567 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 568 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 716 569 717 570 ! !== compute and add the vorticity term trend =! 718 571 jj = 2 719 572 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 720 721 573 DO ji = 2, jpi ! split in 2 parts due to vector opt. 722 574 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 725 577 ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 726 578 END DO 727 !$OMP PARALLEL728 !$OMP DO schedule(static) private(jj,ji)729 579 DO jj = 3, jpj 730 580 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 … … 735 585 END DO 736 586 END DO 737 !$OMP DO schedule(static) private(jj,ji,zua,zva)738 587 DO jj = 2, jpjm1 739 588 DO ji = fs_2, fs_jpim1 ! vector opt. … … 746 595 END DO 747 596 END DO 748 !$OMP END PARALLEL749 597 ! ! =============== 750 598 END DO ! End of slab … … 801 649 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 802 650 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)804 651 DO jk = 1, jpk 805 652 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r7698 r7753 77 77 IF( l_trddyn ) THEN ! Save ua and va trends 78 78 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 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 79 ztrdu(:,:,:) = ua(:,:,:) 80 ztrdv(:,:,:) = va(:,:,:) 88 81 ENDIF 89 82 90 !$OMP PARALLEL91 83 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 92 !$OMP DO schedule(static) private(jj, ji)93 84 DO jj = 2, jpj ! vertical fluxes 94 85 DO ji = fs_2, jpi ! vector opt. … … 96 87 END DO 97 88 END DO 98 !$OMP DO schedule(static) private(jj, ji)99 89 DO jj = 2, jpjm1 ! vertical momentum advection at w-point 100 90 DO ji = fs_2, fs_jpim1 ! vector opt. … … 104 94 END DO 105 95 END DO 106 !$OMP END PARALLEL107 96 ! 108 97 ! Surface and bottom advective fluxes set to zero 109 98 IF ( ln_isfcav ) THEN 110 !$OMP PARALLEL DO schedule(static) private(jj, ji)111 99 DO jj = 2, jpjm1 112 100 DO ji = fs_2, fs_jpim1 ! vector opt. … … 118 106 END DO 119 107 ELSE 120 !$OMP PARALLEL DO schedule(static) private(jj, ji)121 108 DO jj = 2, jpjm1 122 109 DO ji = fs_2, fs_jpim1 ! vector opt. … … 129 116 END IF 130 117 131 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva)132 118 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points 133 119 DO jj = 2, jpjm1 … … 144 130 145 131 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 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 132 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 133 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 155 134 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 156 135 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7698 r7753 53 53 !! 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER :: ji, jj, jk ! dummy loop indices56 55 ! 57 56 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 67 66 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 68 67 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 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 68 ztrdu(:,:,:) = ua(:,:,:) 69 ztrdv(:,:,:) = va(:,:,:) 78 70 ENDIF 79 71 … … 86 78 87 79 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 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 80 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 81 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 97 82 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 98 83 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r7698 r7753 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)95 94 DO jk = 1, jpkm1 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 95 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 96 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 102 97 END DO 103 98 ELSE ! applied on thickness weighted velocity 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)105 99 DO jk = 1, jpkm1 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 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) 114 104 END DO 115 105 ENDIF … … 122 112 ! 123 113 IF( ln_bfrimp ) THEN 124 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)125 114 DO jj = 2, jpjm1 126 115 DO ji = 2, jpim1 … … 132 121 END DO 133 122 IF ( ln_isfcav ) THEN 134 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)135 123 DO jj = 2, jpjm1 136 124 DO ji = 2, jpim1 … … 150 138 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 151 139 IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 152 !$OMP PARALLEL153 !$OMP DO schedule(static) private(jk,jj,ji)154 140 DO jk = 1, jpkm1 ! remove barotropic velocities 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) 141 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 142 va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 143 END DO 163 144 DO jj = 2, jpjm1 ! Add bottom/top stress due to barotropic component only 164 145 DO ji = fs_2, fs_jpim1 ! vector opt. … … 171 152 END DO 172 153 END DO 173 !$OMP END DO NOWAIT174 !$OMP END PARALLEL175 154 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va)177 155 DO jj = 2, jpjm1 178 156 DO ji = fs_2, fs_jpim1 ! vector opt. … … 194 172 ! non zero value at the ocean bottom depending on the bottom friction used. 195 173 ! 196 !$OMP PARALLEL197 !$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws)198 174 DO jk = 1, jpkm1 ! Matrix 199 175 DO jj = 2, jpjm1 … … 208 184 END DO 209 185 END DO 210 !$OMP DO schedule(static) private(jj, ji)211 186 DO jj = 2, jpjm1 ! Surface boundary conditions 212 187 DO ji = fs_2, fs_jpim1 ! vector opt. … … 232 207 ! 233 208 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 234 !$OMP DO schedule(static) private(jj, ji)235 209 DO jj = 2, jpjm1 236 210 DO ji = fs_2, fs_jpim1 ! vector opt. … … 238 212 END DO 239 213 END DO 240 !$OMP END DO NOWAIT 241 END DO 242 ! 243 !$OMP DO schedule(static) private(jj, ji, ze3ua) 214 END DO 215 ! 244 216 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 245 217 DO ji = fs_2, fs_jpim1 ! vector opt. … … 250 222 END DO 251 223 DO jk = 2, jpkm1 252 !$OMP DO schedule(static) private(jj, ji)253 224 DO jj = 2, jpjm1 254 225 DO ji = fs_2, fs_jpim1 … … 258 229 END DO 259 230 ! 260 !$OMP DO schedule(static) private(jj, ji)261 231 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 262 232 DO ji = fs_2, fs_jpim1 ! vector opt. … … 265 235 END DO 266 236 DO jk = jpk-2, 1, -1 267 !$OMP DO schedule(static) private(jj, ji)268 237 DO jj = 2, jpjm1 269 238 DO ji = fs_2, fs_jpim1 … … 279 248 ! non zero value at the ocean bottom depending on the bottom friction used 280 249 ! 281 !$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws)282 250 DO jk = 1, jpkm1 ! Matrix 283 251 DO jj = 2, jpjm1 … … 292 260 END DO 293 261 END DO 294 !$OMP DO schedule(static) private(jj, ji)295 262 DO jj = 2, jpjm1 ! Surface boundary conditions 296 263 DO ji = fs_2, fs_jpim1 ! vector opt. … … 316 283 ! 317 284 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 318 !$OMP DO schedule(static) private(jj, ji)319 285 DO jj = 2, jpjm1 320 286 DO ji = fs_2, fs_jpim1 ! vector opt. … … 322 288 END DO 323 289 END DO 324 !$OMP END DO NOWAIT 325 END DO 326 ! 327 !$OMP DO schedule(static) private(jj, ji, ze3va) 290 END DO 291 ! 328 292 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 329 293 DO ji = fs_2, fs_jpim1 ! vector opt. … … 334 298 END DO 335 299 DO jk = 2, jpkm1 336 !$OMP DO schedule(static) private(jj, ji)337 300 DO jj = 2, jpjm1 338 301 DO ji = fs_2, fs_jpim1 ! vector opt. … … 342 305 END DO 343 306 ! 344 !$OMP DO schedule(static) private(jj, ji)345 307 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 346 308 DO ji = fs_2, fs_jpim1 ! vector opt. … … 349 311 END DO 350 312 DO jk = jpk-2, 1, -1 351 !$OMP DO schedule(static) private(jj, ji)352 313 DO jj = 2, jpjm1 353 314 DO ji = fs_2, fs_jpim1 … … 355 316 END DO 356 317 END DO 357 !$OMP END DO NOWAIT 358 END DO 359 !$OMP END PARALLEL 318 END DO 360 319 361 320 ! J. Chanut: Lines below are useless ? … … 363 322 !!gm I almost sure it is !!!! 364 323 IF( ln_bfrimp ) THEN 365 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)366 324 DO jj = 2, jpjm1 367 325 DO ji = 2, jpim1 … … 373 331 END DO 374 332 IF (ln_isfcav) THEN 375 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv)376 333 DO jj = 2, jpjm1 377 334 DO ji = 2, jpim1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7698 r7753 72 72 INTEGER, INTENT(in) :: kt ! time step 73 73 ! 74 INTEGER :: jk , jj, ji! dummy loop indice74 INTEGER :: jk ! 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 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 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 109 103 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 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 104 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 116 105 END DO 117 106 ! ! Sea surface elevation time stepping … … 119 108 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 120 109 ! 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 110 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 111 128 112 IF ( .NOT.ln_dynspg_ts ) THEN 129 113 ! These lines are not necessary with time splitting since … … 141 125 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 142 126 CALL ssh_asm_inc( kt ) 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 127 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 149 128 ENDIF 150 129 #endif … … 192 171 IF(lwp) WRITE(numout,*) '~~~~~ ' 193 172 ! 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 173 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 200 174 ENDIF 201 175 ! !------------------------------! … … 207 181 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 208 182 CALL wrk_alloc( jpi, jpj, jpk, zhdiv ) 209 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)210 183 ! 211 184 DO jk = 1, jpkm1 … … 223 196 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 224 197 ! computation of w 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 198 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 199 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 232 200 END DO 233 201 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 235 203 ELSE ! z_star and linear free surface cases 236 204 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 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 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) 245 208 END DO 246 209 ENDIF 247 210 248 211 IF( ln_bdy ) THEN 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)250 212 DO jk = 1, jpkm1 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 213 wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 256 214 END DO 257 215 ENDIF … … 283 241 INTEGER, INTENT(in) :: kt ! ocean time-step index 284 242 ! 285 INTEGER :: ji, jj, jk ! dummy loop indices286 243 REAL(wp) :: zcoef ! local scalar 287 244 !!---------------------------------------------------------------------- … … 297 254 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 298 255 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 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 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 306 258 ! 307 259 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 308 260 ! ! before <-- now filtered 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 261 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 315 262 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 316 263 zcoef = atfp * rdt * r1_rau0 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 264 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 265 & - rnf_b(:,:) + rnf (:,:) & 266 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 325 267 ENDIF 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 268 sshn(:,:) = ssha(:,:) ! now <-- after 332 269 ENDIF 333 270 !
Note: See TracChangeset
for help on using the changeset viewer.
