Changeset 4032
- Timestamp:
- 2013-09-21T16:15:51+02:00 (10 years ago)
- Location:
- branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM
- Files:
-
- 1 added
- 23 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3704 r4032 176 176 IF( lk_diaar5 ) THEN 177 177 z3d(:,:,jpk) = 0.e0 178 !$OMP PARALLEL DO schedule(static) private(jk) 178 179 DO jk = 1, jpkm1 179 180 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) … … 698 699 CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current 699 700 IF( ln_traldf_gdia ) THEN 701 !$OMP PARALLEL DO schedule(static) private(jk) 700 702 DO jk=1,jpk-1 701 703 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz … … 713 715 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 714 716 IF( ln_traldf_gdia ) THEN 717 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 715 718 DO jk=1,jpk-1 716 719 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4006 r4032 780 780 IF( nn_timing == 1 ) CALL timing_start('zgr_zco') 781 781 ! 782 !$OMP PARALLEL DO schedule(static) private(jk) 782 783 DO jk = 1, jpk 783 784 gdept(:,:,jk) = gdept_0(jk) -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r3764 r4032 345 345 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 346 346 347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 347 348 DO jk = 1, jpk 348 349 DO jj = 1, jpj -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r3294 r4032 88 88 INTEGER :: ii, ij, ijt, iju, ierr ! local integer 89 89 REAL(wp) :: zraur, zdep ! local scalar 90 REAL(wp), POINTER, DIMENSION(:,: ) :: zwu ! specific 2D workspace91 REAL(wp), POINTER, DIMENSION(:,: ) :: zwv ! specific 2D workspace90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwu ! specific 3D workspace 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwv ! specific 3D workspace 92 92 !!---------------------------------------------------------------------- 93 93 ! 94 94 IF( nn_timing == 1 ) CALL timing_start('div_cur') 95 95 ! 96 CALL wrk_alloc( jpi , jpj+2, zwu)97 CALL wrk_alloc( jpi+4, jpj , zwv, kjstart = -1 )96 CALL wrk_alloc( jpi , jpj+2, jk, zwu, ) 97 CALL wrk_alloc( jpi+4, jpj , jk, zwv, kjstart = -1 ) 98 98 ! 99 99 IF( kt == nit000 ) THEN … … 104 104 105 105 ! ! =============== 106 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 106 107 DO jk = 1, jpkm1 ! Horizontal slab 107 108 ! ! =============== … … 136 137 DO jj = 1, jpj 137 138 DO ji = 1, jpi 138 zwu(ji,jj ) = e1u(ji,jj) * un(ji,jj,jk)139 zwv(ji,jj ) = e2v(ji,jj) * vn(ji,jj,jk)139 zwu(ji,jj,jk) = e1u(ji,jj) * un(ji,jj,jk) 140 zwv(ji,jj,jk) = e2v(ji,jj) * vn(ji,jj,jk) 140 141 END DO 141 142 END DO … … 143 144 ! East-West boundary conditions 144 145 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 145 zwv( 0 ,: ) = zwv(jpi-2,:)146 zwv( -1 ,: ) = zwv(jpi-3,:)147 zwv(jpi+1,: ) = zwv( 3 ,:)148 zwv(jpi+2,: ) = zwv( 4 ,:)146 zwv( 0 ,:,jk) = zwv(jpi-2,:,jk) 147 zwv( -1 ,:,jk) = zwv(jpi-3,:,jk) 148 zwv(jpi+1,:,jk) = zwv( 3 ,:,jk) 149 zwv(jpi+2,:,jk) = zwv( 4 ,:,jk) 149 150 ELSE 150 zwv( 0 ,: ) = 0.e0151 zwv( -1 ,: ) = 0.e0152 zwv(jpi+1,: ) = 0.e0153 zwv(jpi+2,: ) = 0.e0151 zwv( 0 ,:,jk) = 0.e0 152 zwv( -1 ,:,jk) = 0.e0 153 zwv(jpi+1,:,jk) = 0.e0 154 zwv(jpi+2,:,jk) = 0.e0 154 155 ENDIF 155 156 … … 157 158 IF( nperio == 3 .OR. nperio == 4 ) THEN 158 159 ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre 159 zwu(jpi,jpj+1 ) = 0.e0160 zwu(jpi,jpj+2 ) = 0.e0160 zwu(jpi,jpj+1,jk) = 0.e0 161 zwu(jpi,jpj+2,jk) = 0.e0 161 162 DO ji = 1, jpi-1 162 163 iju = jpi - ji + 1 163 zwu(ji,jpj+1 ) = - zwu(iju,jpj-3)164 zwu(ji,jpj+2 ) = - zwu(iju,jpj-4)164 zwu(ji,jpj+1,jk) = - zwu(iju,jpj-3,jk) 165 zwu(ji,jpj+2,jk) = - zwu(iju,jpj-4,jk) 165 166 END DO 166 167 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 167 168 ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\ 168 zwu(jpi,jpj+1 ) = 0.e0169 zwu(jpi,jpj+2 ) = 0.e0169 zwu(jpi,jpj+1,jk) = 0.e0 170 zwu(jpi,jpj+2,jk) = 0.e0 170 171 DO ji = 1, jpi-1 171 172 iju = jpi - ji 172 zwu(ji,jpj ) = - zwu(iju,jpj-1)173 zwu(ji,jpj+1 ) = - zwu(iju,jpj-2)174 zwu(ji,jpj+2 ) = - zwu(iju,jpj-3)173 zwu(ji,jpj,jk ) = - zwu(iju,jpj-1,jk) 174 zwu(ji,jpj+1,jk) = - zwu(iju,jpj-2,jk) 175 zwu(ji,jpj+2,jk) = - zwu(iju,jpj-3,jk) 175 176 END DO 176 177 DO ji = -1, jpi+2 177 178 ijt = jpi - ji + 1 178 zwv(ji,jpj ) = - zwv(ijt,jpj-2)179 zwv(ji,jpj,jk) = - zwv(ijt,jpj-2,jk) 179 180 END DO 180 181 DO ji = jpi/2+1, jpi+2 181 182 ijt = jpi - ji + 1 182 zwv(ji,jpjm1 ) = - zwv(ijt,jpjm1)183 zwv(ji,jpjm1,jk) = - zwv(ijt,jpjm1,jk) 183 184 END DO 184 185 ELSE 185 186 ! closed 186 zwu(:,jpj+1 ) = 0.e0187 zwu(:,jpj+2 ) = 0.e0187 zwu(:,jpj+1,jk) = 0.e0 188 zwu(:,jpj+2,jk) = 0.e0 188 189 ENDIF 189 190 … … 191 192 DO jj = 1, jpjm1 192 193 DO ji = 1, fs_jpim1 ! vector opt. 193 rotn(ji,jj,jk) = ( zwv(ji+1,jj ) - zwv(ji,jj) &194 & - zwu(ji ,jj+1 ) + zwu(ji,jj) ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )194 rotn(ji,jj,jk) = ( zwv(ji+1,jj,jk ) - zwv(ji,jj,jk) & 195 & - zwu(ji ,jj+1,jk) + zwu(ji,jj,jk) ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 195 196 END DO 196 197 END DO … … 201 202 ij = njcoa(jl,1,jk) 202 203 rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) ) & 203 * ( + 4. * zwv(ii+1,ij ) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) )204 * ( + 4. * zwv(ii+1,ij,jk) - zwv(ii+2,ij,jk) + 0.2 * zwv(ii+3,ij,jk) ) 204 205 END DO 205 206 DO jl = 1, npcoa(2,jk) … … 207 208 ij = njcoa(jl,2,jk) 208 209 rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij)) & 209 *(-4.*zwv(ii,ij )+zwv(ii-1,ij)-0.2*zwv(ii-2,ij))210 *(-4.*zwv(ii,ij,jk)+zwv(ii-1,ij,jk)-0.2*zwv(ii-2,ij,jk)) 210 211 END DO 211 212 DO jl = 1, npcoa(3,jk) … … 213 214 ij = njcoa(jl,3,jk) 214 215 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 215 * ( +4. * zwu(ii,ij+1 ) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) )216 * ( +4. * zwu(ii,ij+1,jk) - zwu(ii,ij+2,jk) + 0.2 * zwu(ii,ij+3,jk) ) 216 217 END DO 217 218 DO jl = 1, npcoa(4,jk) … … 219 220 ij = njcoa(jl,4,jk) 220 221 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 221 * ( -4. * zwu(ii,ij ) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )222 * ( -4. * zwu(ii,ij,jk) + zwu(ii,ij-1,jk) - 0.2 * zwu(ii,ij-2,jk) ) 222 223 END DO 223 224 ! ! =============== … … 284 285 285 286 ! ! =============== 287 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 286 288 DO jk = 1, jpkm1 ! Horizontal slab 287 289 ! ! =============== -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3294 r4032 79 79 80 80 ! ! =============== 81 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 81 82 DO jk = 1, jpkm1 ! Horizontal slab 82 83 ! ! =============== -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3294 r4032 77 77 ENDIF 78 78 ! ! =============== 79 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze2u, ze1v, zua, zva) 79 80 DO jk = 1, jpkm1 ! Horizontal slab 80 81 ! ! =============== -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r3764 r4032 133 133 ! 134 134 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 135 !$OMP PARALLEL DO schedule(static) private(jk) 135 136 DO jk = 1, jpkm1 136 137 ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk) … … 138 139 END DO 139 140 ELSE ! applied on thickness weighted velocity 141 !$OMP PARALLEL DO schedule(static) private(jk) 140 142 DO jk = 1, jpkm1 141 143 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & … … 190 192 ! ------------------------------------------ 191 193 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 194 !$OMP PARALLEL DO schedule(static) private(jk) 192 195 DO jk = 1, jpkm1 193 196 un(:,:,jk) = ua(:,:,jk) ! un <-- ua … … 198 201 IF( .NOT. lk_vvl ) THEN ! Fixed volume ! 199 202 ! ! =============! 203 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 200 204 DO jk = 1, jpkm1 201 205 DO jj = 1, jpj … … 215 219 ! ! ================! 216 220 ! 221 !$OMP PARALLEL DO schedule(static) private(jk) 217 222 DO jk = 1, jpkm1 ! Before scale factor at t-points 218 223 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) & … … 228 233 CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 229 234 ! 235 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 230 236 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: applied on velocity 231 237 DO jj = 1, jpj ! -------- … … 246 252 CALL dom_vvl_2( kt, ze3u_f, ze3v_f ) ! before scale factors at u- & v-pts (computed from fse3t_b) 247 253 ! 254 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zue3b, zve3b, zue3n, zve3n, zue3a, zve3a, zuf, zvf) 248 255 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: 249 256 DO jj = 1, jpj ! applied on thickness weighted velocity -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r4010 r4032 140 140 ! 141 141 IF( ln_dynadv_vec ) THEN ! vector form : applied on velocity 142 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 142 143 DO jk = 1, jpkm1 143 144 DO jj = 2, jpjm1 … … 150 151 ! 151 152 ELSE ! flux form : applied on thickness weighted velocity 153 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 152 154 DO jk = 1, jpkm1 153 155 DO jj = 2, jpjm1 … … 173 175 END DO 174 176 END DO 177 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 175 178 DO jk = 1, jpkm1 ! unweighted time stepping 176 179 DO jj = 2, jpjm1 … … 345 348 ! trend, the leap-frog time stepping will not 346 349 ! be done in dynnxt.F90 routine) 350 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 347 351 DO jk = 1, jpkm1 348 352 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r3802 r4032 225 225 INTEGER :: ji, jj, jk ! dummy loop indices 226 226 REAL(wp) :: zx1, zy1, zfact2, zx2, zy2 ! local scalars 227 REAL(wp), POINTER, DIMENSION(:,: ) :: zwx, zwy, zwz227 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy, zwz 228 228 !!---------------------------------------------------------------------- 229 229 ! 230 230 IF( nn_timing == 1 ) CALL timing_start('vor_ene') 231 231 ! 232 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz )232 CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz ) 233 233 ! 234 234 IF( kt == nit000 ) THEN … … 242 242 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 243 243 ! ! =============== 244 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zy1, zy2, zx1, zx2) 244 245 DO jk = 1, jpkm1 ! Horizontal slab 245 246 ! ! =============== … … 248 249 ! ----------------------------------------- 249 250 SELECT CASE( kvor ) ! vorticity considered 250 CASE ( 1 ) ; zwz(:,: ) = ff(:,:) ! planetary vorticity (Coriolis)251 CASE ( 2 ) ; zwz(:,: ) = rotn(:,:,jk) ! relative vorticity251 CASE ( 1 ) ; zwz(:,:,jk) = ff(:,:) ! planetary vorticity (Coriolis) 252 CASE ( 2 ) ; zwz(:,:,jk) = rotn(:,:,jk) ! relative vorticity 252 253 CASE ( 3 ) ! metric term 253 254 DO jj = 1, jpjm1 254 255 DO ji = 1, fs_jpim1 ! vector opt. 255 zwz(ji,jj ) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &256 zwz(ji,jj,jk) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 256 257 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 257 258 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 258 259 END DO 259 260 END DO 260 CASE ( 4 ) ; zwz(:,: ) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity)261 CASE ( 4 ) ; zwz(:,:,jk) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity) 261 262 CASE ( 5 ) ! total (coriolis + metric) 262 263 DO jj = 1, jpjm1 263 264 DO ji = 1, fs_jpim1 ! vector opt. 264 zwz(ji,jj ) = ( ff (ji,jj) &265 zwz(ji,jj,jk) = ( ff (ji,jj) & 265 266 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 266 267 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & … … 272 273 273 274 IF( ln_sco ) THEN 274 zwz(:,: ) = zwz(:,:) / fse3f(:,:,jk)275 zwx(:,: ) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)276 zwy(:,: ) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)275 zwz(:,:,jk) = zwz(:,:,jk) / fse3f(:,:,jk) 276 zwx(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 277 zwy(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 277 278 ELSE 278 zwx(:,: ) = e2u(:,:) * un(:,:,jk)279 zwy(:,: ) = e1v(:,:) * vn(:,:,jk)279 zwx(:,:,jk) = e2u(:,:) * un(:,:,jk) 280 zwy(:,:,jk) = e1v(:,:) * vn(:,:,jk) 280 281 ENDIF 281 282 … … 284 285 DO jj = 2, jpjm1 285 286 DO ji = fs_2, fs_jpim1 ! vector opt. 286 zy1 = zwy(ji,jj-1 ) + zwy(ji+1,jj-1)287 zy2 = zwy(ji,jj ) + zwy(ji+1,jj)288 zx1 = zwx(ji-1,jj ) + zwx(ji-1,jj+1)289 zx2 = zwx(ji ,jj ) + zwx(ji ,jj+1)290 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji ,jj-1 ) * zy1 + zwz(ji,jj) * zy2 )291 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )287 zy1 = zwy(ji,jj-1,jk) + zwy(ji+1,jj-1,jk) 288 zy2 = zwy(ji,jj, jk ) + zwy(ji+1,jj, jk ) 289 zx1 = zwx(ji-1,jj,jk) + zwx(ji-1,jj+1,jk) 290 zx2 = zwx(ji ,jj, jk) + zwx(ji ,jj+1, jk) 291 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji ,jj-1,jk) * zy1 + zwz(ji,jj,jk) * zy2 ) 292 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj,jk ) * zx1 + zwz(ji,jj,jk) * zx2 ) 292 293 END DO 293 294 END DO … … 295 296 END DO ! End of slab 296 297 ! ! =============== 297 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )298 CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz ) 298 299 ! 299 300 IF( nn_timing == 1 ) CALL timing_stop('vor_ene') -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3294 r4032 60 60 REAL(wp) :: zua, zva ! temporary scalars 61 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwuw , zwvw 62 REAL(wp), POINTER, DIMENSION(:,: ) :: zww63 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 64 63 !!---------------------------------------------------------------------- … … 66 65 IF( nn_timing == 1 ) CALL timing_start('dyn_zad') 67 66 ! 68 CALL wrk_alloc( jpi,jpj, zww )69 67 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw ) 70 68 ! … … 80 78 ENDIF 81 79 80 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 82 81 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 83 DO jj = 2, jpj ! vertical fluxes84 DO ji = fs_2, jpi ! vector opt.85 zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)86 END DO87 END DO88 82 DO jj = 2, jpjm1 ! vertical momentum advection at w-point 89 83 DO ji = fs_2, fs_jpim1 ! vector opt. 90 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj)) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )91 zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj)) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )84 zwuw(ji,jj,jk) = ( 0.25 * e1t(ji+1,jj) * e2t(ji+1,jj) * wn(ji+1,jj,jk) + 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)) * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 85 zwvw(ji,jj,jk) = ( 0.25 * e1t(ji,jj+1) * e2t(ji,jj+1) * wn(ji,jj+1,jk) + 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) ) 92 86 END DO 93 87 END DO … … 102 96 END DO 103 97 98 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 104 99 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points 105 100 DO jj = 2, jpjm1 … … 125 120 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 126 121 ! 127 CALL wrk_dealloc( jpi,jpj, zww )128 122 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw ) 129 123 ! -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r3625 r4032 116 116 ! non zero value at the ocean bottom depending on the bottom friction used. 117 117 ! 118 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcoef, zzwi, zzws) 118 119 DO jk = 1, jpkm1 ! Matrix 119 120 DO jj = 2, jpjm1 … … 187 188 188 189 ! Normalization to obtain the general momentum trend ua 190 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 189 191 DO jk = 1, jpkm1 190 192 DO jj = 2, jpjm1 … … 202 204 ! non zero value at the ocean bottom depending on the bottom friction used 203 205 ! 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcoef, zzwi, zzws) 204 207 DO jk = 1, jpkm1 ! Matrix 205 208 DO jj = 2, jpjm1 … … 273 276 274 277 ! Normalization to obtain the general momentum trend va 278 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 275 279 DO jk = 1, jpkm1 276 280 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r3764 r4032 130 130 IF( lk_vvl ) THEN ! Regridding: Update Now Vertical coord. ! (only in vvl case) 131 131 ! !------------------------------------------! 132 !$OMP PARALLEL DO schedule(static) private(jk) 132 133 DO jk = 1, jpkm1 133 134 fsdept(:,:,jk) = fsdept_n(:,:,jk) ! now local depths stored in fsdep. arrays … … 229 230 CALL wrk_alloc( jpi,jpj,jpk, z3d ) 230 231 z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 232 !$OMP PARALLEL DO schedule(static) private(jk) 231 233 DO jk = 1, jpk 232 234 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4017 r4032 760 760 ! 761 761 ! WARNING ptab is defined only between nld and nle 762 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 762 763 DO jk = 1, jpk 763 764 DO jj = nlcj+1, jpj ! added line(s) (inner only) -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r3848 r4032 125 125 zwz(:,:,:) = 0._wp 126 126 ! 127 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 127 128 DO jk = 1, jpk !== i- & j-gradient of density ==! 128 129 DO jj = 1, jpjm1 … … 148 149 ! 149 150 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 151 !$OMP PARALLEL DO schedule(static) private(jk) 150 152 DO jk = 2, jpkm1 151 153 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 165 167 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 166 168 ! 169 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi) 167 170 DO jk = 2, jpkm1 !* Slopes at u and v points 168 171 DO jj = 2, jpjm1 … … 203 206 ! 204 207 ! !* horizontal Shapiro filter 208 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 205 209 DO jk = 2, jpkm1 206 210 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 247 251 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 248 252 ! 253 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 249 254 DO jk = 2, jpkm1 250 255 DO jj = 2, jpjm1 … … 285 290 ! 286 291 ! !* horizontal Shapiro filter 292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 287 293 DO jk = 2, jpkm1 288 294 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only … … 658 664 ! 659 665 ! !== surface mixed layer mask ! 666 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ik) 660 667 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 661 668 # if defined key_vectopt_loop -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r3625 r4032 135 135 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 136 136 ! 137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrhop, zaw, za, zb1, za1, zkw, zk0, ze, zbw, zb, zd, zc, zr1, zr2, zr3, zr4, zt, zs, zh, zsr) 137 138 DO jk = 1, jpkm1 138 139 DO jj = 1, jpj … … 178 179 ! 179 180 CASE( 1 ) !== Linear formulation function of temperature only ==! 181 !$OMP PARALLEL DO schedule(static) private(jk) 180 182 DO jk = 1, jpkm1 181 183 prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) … … 183 185 ! 184 186 CASE( 2 ) !== Linear formulation function of temperature and salinity ==! 187 !$OMP PARALLEL DO schedule(static) private(jk) 185 188 DO jk = 1, jpkm1 186 189 prd(:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) … … 266 269 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 267 270 ! 271 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrhop, zaw, za, zb1, za1, zkw, zk0, ze, zbw, zb, zd, zc, zr1, zr2, zr3, zr4, zt, zs, zh, zsr) 268 272 DO jk = 1, jpkm1 269 273 DO jj = 1, jpj … … 312 316 ! 313 317 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 318 !$OMP PARALLEL DO schedule(static) private(jk) 314 319 DO jk = 1, jpkm1 315 320 prd (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) … … 318 323 ! 319 324 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 325 !$OMP PARALLEL DO schedule(static) private(jk) 320 326 DO jk = 1, jpkm1 321 327 prd (:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) … … 516 522 ! 517 523 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 524 #if defined key_zdfddm 525 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zgde3w, zt, zs, zh, zalbet, zbeta, zds) 526 #else 527 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zgde3w, zt, zs, zh, zalbet, zbeta) 528 #endif 518 529 DO jk = 2, jpkm1 519 530 DO jj = 1, jpj … … 563 574 ! 564 575 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 576 !$OMP PARALLEL DO schedule(static) private(jk) 565 577 DO jk = 2, jpkm1 566 578 pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) … … 568 580 ! 569 581 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 582 !$OMP PARALLEL DO schedule(static) private(jk) 570 583 DO jk = 2, jpkm1 571 584 pn2(:,:,jk) = grav * ( rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) & … … 574 587 END DO 575 588 #if defined key_zdfddm 589 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zds) 576 590 DO jk = 2, jpkm1 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 577 591 DO jj = 1, jpj -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r3718 r4032 87 87 ! 88 88 ! !== effective transport ==! 89 !$OMP PARALLEL DO schedule(static) private(jk) 89 90 DO jk = 1, jpkm1 90 91 zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r3625 r4032 116 116 ! -------------------------------------------------------------------- 117 117 ! upstream tracer flux in the i and j direction 118 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui, zfm_ui) 118 119 DO jk = 1, jpkm1 119 120 DO jj = 1, jpjm1 … … 136 137 ENDIF 137 138 ! Interior value 139 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 138 140 DO jk = 2, jpkm1 139 141 DO jj = 1, jpj … … 147 149 148 150 ! total advective trend 151 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 149 152 DO jk = 1, jpkm1 150 153 z2dtt = p2dt(jk) … … 179 182 ! -------------------------------------------------- 180 183 ! antidiffusive flux on i and j 184 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 181 185 DO jk = 1, jpkm1 182 186 DO jj = 1, jpjm1 … … 191 195 zwz(:,:,1) = 0.e0 ! Surface value 192 196 ! 197 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 193 198 DO jk = 2, jpkm1 ! Interior value 194 199 DO jj = 1, jpj … … 208 213 ! 5. final trend with corrected fluxes 209 214 ! ------------------------------------ 215 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 210 216 DO jk = 1, jpkm1 211 217 DO jj = 2, jpjm1 … … 292 298 & paft * tmask + zbig * ( 1.e0 - tmask ) ) 293 299 300 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zpos, zneg, zbt, ikm1, z2dtt, zup, zdo) 294 301 DO jk = 1, jpkm1 295 302 ikm1 = MAX(jk-1,1) … … 331 338 ! 3. monotonic flux in the i & j direction (paa & pbb) 332 339 ! ---------------------------------------- 340 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 333 341 DO jk = 1, jpkm1 334 342 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r3805 r4032 110 110 REAL(wp) :: zztmp ! local scalar 111 111 #endif 112 REAL(wp) :: zdkt_scal1, zdkt_scal2, zdkt_scal3, zdk1t_scal1, zdk1t_scal2, zdk1t_scal3 112 113 REAL(wp), POINTER, DIMENSION(:,: ) :: zdkt, zdk1t, z2d 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw … … 139 140 140 141 ! Horizontal tracer gradient 142 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 141 143 DO jk = 1, jpkm1 142 144 DO jj = 1, jpjm1 … … 161 163 !CDIR PARALLEL DO PRIVATE( zdk1t ) 162 164 ! ! =============== 163 DO jk = 1, jpkm1 ! Horizontal slab 165 ! ! =============== 166 ! 1. Vertical tracer gradient at level jk and jk+1 167 ! ------------------------------------------------ 168 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 169 zdk1t(:,:) = ( ptb(:,:,1,jn) - ptb(:,:,2,jn) ) * tmask(:,:,2) 170 zdkt(:,:) = zdk1t(:,:) 171 172 ! 2. Horizontal fluxes 173 ! -------------------- 174 DO jj = 1 , jpjm1 175 DO ji = 1, fs_jpim1 ! vector opt. 176 zabe1 = ( fsahtu(ji,jj,1) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,1) / e1u(ji,jj) 177 zabe2 = ( fsahtv(ji,jj,1) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,1) / e2v(ji,jj) 178 ! 179 zmsku = 1. / MAX( tmask(ji+1,jj,1 ) + tmask(ji,jj,2) & 180 & + tmask(ji+1,jj,2) + tmask(ji,jj,1 ), 1. ) 181 ! 182 zmskv = 1. / MAX( tmask(ji,jj+1,1 ) + tmask(ji,jj,2) & 183 & + tmask(ji,jj+1,2) + tmask(ji,jj,1 ), 1. ) 184 ! 185 zcof1 = - fsahtu(ji,jj,1) * e2u(ji,jj) * uslp(ji,jj,1) * zmsku 186 zcof2 = - fsahtv(ji,jj,1) * e1v(ji,jj) * vslp(ji,jj,1) * zmskv 187 ! 188 zftu(ji,jj,1 ) = ( zabe1 * zdit(ji,jj,1) & 189 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 190 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,1) 191 zftv(ji,jj,1) = ( zabe2 * zdjt(ji,jj,1) & 192 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 193 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,1) 194 END DO 195 END DO 196 197 ! II.4 Second derivative (divergence) and add to the general trend 198 ! ---------------------------------------------------------------- 199 DO jj = 2 , jpjm1 200 DO ji = fs_2, fs_jpim1 ! vector opt. 201 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) ) 202 ztra = zbtr * ( zftu(ji,jj,1) - zftu(ji-1,jj,1) + zftv(ji,jj,1) - zftv(ji,jj-1,1) ) 203 pta(ji,jj,1,jn) = pta(ji,jj,1,jn) + ztra 204 END DO 205 END DO 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdkt_scal1, zdkt_scal2, zdkt_scal3, zdk1t_scal1, zdk1t_scal2, zdk1t_scal3, zbtr, ztra, zcof1, zcof2, zabe1, zabe2, zmskv, zmsku) 207 DO jk = 2, jpkm1 ! Horizontal slab 164 208 ! ! =============== 165 209 ! 1. Vertical tracer gradient at level jk and jk+1 166 210 ! ------------------------------------------------ 167 211 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 168 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)169 !170 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:)171 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)172 ENDIF173 212 174 213 ! 2. Horizontal fluxes … … 176 215 DO jj = 1 , jpjm1 177 216 DO ji = 1, fs_jpim1 ! vector opt. 217 zdk1t_scal1 = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 218 zdk1t_scal2 = ( ptb(ji+1,jj,jk,jn) - ptb(ji+1,jj,jk+1,jn) ) * tmask(ji+1,jj,jk+1) 219 zdk1t_scal3 = ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj+1,jk+1,jn) ) * tmask(ji,jj+1,jk+1) 220 zdkt_scal1 = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 221 zdkt_scal2 = ( ptb(ji+1,jj,jk-1,jn) - ptb(ji+1,jj,jk,jn) ) * tmask(ji+1,jj,jk) 222 zdkt_scal3 = ( ptb(ji,jj+1,jk-1,jn) - ptb(ji,jj+1,jk,jn) ) * tmask(ji,jj+1,jk) 178 223 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 179 224 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) … … 189 234 ! 190 235 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 191 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj)&192 & + zdk1t (ji+1,jj) + zdkt (ji,jj)) ) * umask(ji,jj,jk)236 & + zcof1 * ( zdkt_scal2 + zdk1t_scal1 & 237 & + zdk1t_scal2 + zdkt_scal1 ) ) * umask(ji,jj,jk) 193 238 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 194 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj)&195 & + zdk1t (ji,jj+1) + zdkt (ji,jj)) ) * vmask(ji,jj,jk)239 & + zcof2 * ( zdkt_scal3 + zdk1t_scal1 & 240 & + zdk1t_scal3 + zdkt_scal1 ) ) * vmask(ji,jj,jk) 196 241 END DO 197 242 END DO … … 261 306 262 307 ! interior (2=<jk=<jpk-1) 308 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcoef0, zmsku, zmskv, zcoef3, zcoef4) 263 309 DO jk = 2, jpkm1 264 310 DO jj = 2, jpjm1 … … 285 331 ! I.5 Divergence of vertical fluxes added to the general tracer trend 286 332 ! ------------------------------------------------------------------- 333 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 287 334 DO jk = 1, jpkm1 288 335 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r3294 r4032 136 136 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 137 137 DO jn = 1, jpts 138 !$OMP PARALLEL DO schedule(static) private(jk) 138 139 DO jk = 1, jpkm1 139 140 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) … … 154 155 ! trends computation 155 156 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 157 !$OMP PARALLEL DO schedule(static) private(jk, zfact) 156 158 DO jk = 1, jpkm1 157 159 zfact = 1.e0 / r2dtra(jk) -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r3680 r4032 145 145 IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN ! bio-model fluxes : all vertical coordinates ! 146 146 ! ! ============================================== ! 147 !$OMP PARALLEL DO schedule(static) private(jk) 147 148 DO jk = 1, jpkm1 148 149 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 149 150 END DO 150 151 ! Add to the general trend 152 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, z1_e3t) 151 153 DO jk = 1, jpkm1 152 154 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r3294 r4032 125 125 ! isoneutral diffusion: add the contribution 126 126 IF( ln_traldf_grif ) THEN ! Griffies isoneutral diff 127 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 127 128 DO jk = 2, jpkm1 128 129 DO jj = 2, jpjm1 … … 133 134 END DO 134 135 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 136 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 135 137 DO jk = 2, jpkm1 136 138 DO jj = 2, jpjm1 … … 145 147 #endif 146 148 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 149 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3ta, ze3tn) 147 150 DO jk = 1, jpkm1 148 151 DO jj = 2, jpjm1 -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r3294 r4032 77 77 zavm_evd(:,:,:) = avm(:,:,:) ! set avm prior to evd application 78 78 ! 79 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 79 80 DO jk = 1, jpkm1 80 81 #if defined key_vectopt_loop … … 108 109 ! 109 110 CASE DEFAULT ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 111 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 110 112 DO jk = 1, jpkm1 111 113 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! -
branches/2013/dev_r4017_CMCC_MPI_OpenMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r3680 r4032 303 303 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 304 304 !CDIR NOVERRCHK 305 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zus, zind, zwlc) 305 306 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 306 307 !CDIR NOVERRCHK … … 327 328 ! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 328 329 ! 330 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 329 331 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 330 332 DO jj = 1, jpj ! here avmu, avmv used as workspace … … 342 344 END DO 343 345 ! 346 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zesh2, zzd_lw) 344 347 DO jk = 2, jpkm1 !* Matrix and right hand side in en 345 348 DO jj = 2, jpjm1 … … 396 399 END DO 397 400 END DO 401 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 398 402 DO jk = 2, jpkm1 ! set the minimum value of tke 399 403 DO jj = 2, jpjm1 … … 408 412 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 409 413 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 414 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 410 415 DO jk = 2, jpkm1 411 416 DO jj = 2, jpjm1 … … 426 431 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 427 432 !CDIR NOVERRCHK 433 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztau, zdif, ztx2, zty2) 428 434 DO jk = 2, jpkm1 429 435 !CDIR NOVERRCHK … … 514 520 ! 515 521 !CDIR NOVERRCHK 522 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrn2) 516 523 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 517 524 !CDIR NOVERRCHK … … 533 540 ! 534 541 CASE ( 0 ) ! bounded by the distance to surface and bottom 542 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 535 543 DO jk = 2, jpkm1 536 544 DO jj = 2, jpjm1 … … 545 553 ! 546 554 CASE ( 1 ) ! bounded by the vertical scale factor 555 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 547 556 DO jk = 2, jpkm1 548 557 DO jj = 2, jpjm1 … … 589 598 END DO 590 599 !CDIR NOVERRCHK 600 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl, zemlp) 591 601 DO jk = 2, jpkm1 592 602 !CDIR NOVERRCHK … … 613 623 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 614 624 !CDIR NOVERRCHK 625 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav) 615 626 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 616 627 !CDIR NOVERRCHK … … 628 639 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 629 640 ! 641 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 630 642 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 631 643 DO jj = 2, jpjm1 … … 639 651 ! 640 652 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 653 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcoef, zdku, zdkv, zpdlr, zri) 641 654 DO jk = 2, jpkm1 642 655 DO jj = 2, jpjm1 … … 757 770 ENDIF 758 771 ! !* set vertical eddy coef. to the background value 772 !$OMP PARALLEL DO schedule(static) private(jk) 759 773 DO jk = 1, jpk 760 774 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
Note: See TracChangeset
for help on using the changeset viewer.