Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/LDF
 Timestamp:
 20170303T12:46:59+01:00 (4 years ago)
 Location:
 trunk/NEMOGCM/NEMO/OPA_SRC/LDF
 Files:

 4 edited
Legend:
 Unmodified
 Added
 Removed

trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
r7698 r7753 148 148 IF(lwp) WRITE(numout,*) ' momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 149 149 za00 = pah0 / zd_max 150 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)151 150 DO jj = 1, jpj 152 151 DO ji = 1, jpi … … 160 159 IF(lwp) WRITE(numout,*) ' momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 161 160 za00 = pah0 / ( zd_max * zd_max * zd_max ) 162 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)163 161 DO jj = 1, jpj 164 162 DO ji = 1, jpi … … 173 171 ENDIF 174 172 ! ! deeper values (LAP and BLP cases) 175 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)176 173 DO jk = 2, jpk 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 pah1(ji,jj,jk) = pah1(ji,jj,1) * tmask(ji,jj,jk) 180 pah2(ji,jj,jk) = pah2(ji,jj,1) * fmask(ji,jj,jk) 181 END DO 182 END DO 174 pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 175 pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 183 176 END DO 184 177 ! … … 187 180 IF(lwp) WRITE(numout,*) ' tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 188 181 za00 = pah0 / zd_max 189 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)190 182 DO jj = 1, jpj 191 183 DO ji = 1, jpi … … 199 191 IF(lwp) WRITE(numout,*) ' tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 200 192 za00 = pah0 / ( zd_max * zd_max * zd_max ) 201 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2)202 193 DO jj = 1, jpj 203 194 DO ji = 1, jpi … … 212 203 ENDIF 213 204 ! ! deeper values (LAP and BLP cases) 214 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)215 205 DO jk = 2, jpk 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 pah1(ji,jj,jk) = pah1(ji,jj,1) * umask(ji,jj,jk) 219 pah2(ji,jj,jk) = pah2(ji,jj,1) * vmask(ji,jj,jk) 220 END DO 221 END DO 206 pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 207 pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 222 208 END DO 223 209 ! 
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r7698 r7753 155 155 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 156 156 ! 157 !$OMP PARALLEL DO schedule(static) private(jj, ji) 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 ahmt(ji,jj,jpk) = 0._wp ! last level always 0 161 ahmf(ji,jj,jpk) = 0._wp 162 END DO 163 END DO 157 ahmt(:,:,jpk) = 0._wp ! last level always 0 158 ahmf(:,:,jpk) = 0._wp 164 159 ! 165 160 ! ! value of eddy mixing coef. … … 178 173 CASE( 0 ) !== constant ==! 179 174 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant ' 180 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 181 DO jk = 1, jpk 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 ahmt(ji,jj,jk) = zah0 * tmask(ji,jj,jk) 185 ahmf(ji,jj,jk) = zah0 * fmask(ji,jj,jk) 186 END DO 187 END DO 188 END DO 175 ahmt(:,:,:) = zah0 * tmask(:,:,:) 176 ahmf(:,:,:) = zah0 * fmask(:,:,:) 189 177 ! 190 178 CASE( 10 ) !== fixed profile ==! 191 179 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 192 !$OMP PARALLEL DO schedule(static) private(jj, ji) 193 DO jj = 1, jpj 194 DO ji = 1, jpi 195 ahmt(ji,jj,1) = zah0 * tmask(ji,jj,1) ! constant surface value 196 ahmf(ji,jj,1) = zah0 * fmask(ji,jj,1) 197 END DO 198 END DO 180 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 181 ahmf(:,:,1) = zah0 * fmask(:,:,1) 199 182 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 200 183 ! … … 208 191 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 209 192 !! better: check that the max is <=1 i.e. it is a shape from 0 to 1, not a coef that has physical dimension 210 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)211 193 DO jk = 2, jpkm1 212 DO jj = 1, jpj 213 DO ji = 1, jpi 214 ahmt(ji,jj,jk) = ahmt(ji,jj,1) * tmask(ji,jj,jk) 215 ahmf(ji,jj,jk) = ahmf(ji,jj,1) * fmask(ji,jj,jk) 216 END DO 217 END DO 194 ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 195 ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 218 196 END DO 219 197 ! … … 231 209 !!gm Question : info for LAP or BLP case to take into account the SQRT in the bilaplacian case ???? 232 210 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)234 211 DO jk = 1, jpkm1 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * tmask(ji,jj,jk) 238 ahmf(ji,jj,jk) = ahmf(ji,jj,jk) * fmask(ji,jj,jk) 239 END DO 240 END DO 212 ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 213 ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 241 214 END DO 242 215 ! … … 266 239 ! 267 240 ! Set local gridscale values 268 !$OMP PARALLEL DO schedule(static) private(jj,ji)269 241 DO jj = 2, jpjm1 270 242 DO ji = fs_2, fs_jpim1 … … 279 251 ! 280 252 IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN ! bilapcian and no time variation: 281 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 282 DO jk = 1, jpk 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 ahmt(ji,jj,jk) = SQRT( ahmt(ji,jj,jk) ) ! take the square root of the coefficient 286 ahmf(ji,jj,jk) = SQRT( ahmf(ji,jj,jk) ) 287 END DO 288 END DO 289 END DO 253 ahmt(:,:,:) = SQRT( ahmt(:,:,:) ) ! take the square root of the coefficient 254 ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 290 255 ENDIF 291 256 ! 
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r7698 r7753 135 135 z1_slpmax = 1._wp / rn_slpmax 136 136 ! 137 !$OMP PARALLEL 138 !$OMP DO schedule(static) private(jk, jj, ji) 139 DO jk = 1, jpk 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zww(ji,jj,jk) = 0._wp 143 zwz(ji,jj,jk) = 0._wp 144 END DO 145 END DO 146 END DO 147 !$OMP END DO NOWAIT 148 ! 149 !$OMP DO schedule(static) private(jk, jj, ji) 137 zww(:,:,:) = 0._wp 138 zwz(:,:,:) = 0._wp 139 ! 150 140 DO jk = 1, jpk !== i & jgradient of density ==! 151 141 DO jj = 1, jpjm1 … … 156 146 END DO 157 147 END DO 158 !$OMP END PARALLEL159 148 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 160 !$OMP PARALLEL DO schedule(static) private(jj, ji)161 149 DO jj = 1, jpjm1 162 150 DO ji = 1, jpim1 … … 167 155 ENDIF 168 156 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 169 !$OMP PARALLEL DO schedule(static) private(jj, ji)170 157 DO jj = 1, jpjm1 171 158 DO ji = 1, jpim1 … … 176 163 ENDIF 177 164 ! 178 !$OMP PARALLEL 179 !$OMP DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 zdzr(ji,jj,1) = 0._wp !== Local vertical density gradient at Tpoint == ! (evaluated from N^2) 183 END DO 184 END DO 185 !$OMP DO schedule(static) private(jk,jj,ji) 165 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at Tpoint == ! (evaluated from N^2) 186 166 DO jk = 2, jpkm1 187 167 ! ! zdzr = d/dz(prd)=  ( prd ) / grav * mk(pn2)  at t point … … 190 170 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 191 171 ! ! NB: 1/(tmask+1) = (1.5*tmask) substitute a / by a * ==> faster 192 DO jj = 1, jpj 193 DO ji = 1, jpi 194 zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp ) & 195 & * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp  0.5_wp * tmask(ji,jj,jk+1) ) 196 END DO 197 END DO 198 END DO 199 !$OMP END PARALLEL 172 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 173 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp  0.5_wp * tmask(:,:,jk+1) ) 174 END DO 200 175 ! 201 176 ! !== Slopes just below the mixed layer ==! … … 207 182 ! 208 183 IF ( ln_isfcav ) THEN 209 !$OMP PARALLEL DO schedule(static) private(jj,ji)210 184 DO jj = 2, jpjm1 211 185 DO ji = fs_2, fs_jpim1 ! vector opt. … … 217 191 END DO 218 192 ELSE 219 !$OMP PARALLEL DO schedule(static) private(jj,ji)220 193 DO jj = 2, jpjm1 221 194 DO ji = fs_2, fs_jpim1 ! vector opt. … … 226 199 END IF 227 200 228 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv)229 201 DO jk = 2, jpkm1 !* Slopes at u and v points 230 202 DO jj = 2, jpjm1 … … 267 239 ! 268 240 ! !* horizontal Shapiro filter 269 !$OMP PARALLEL270 !$OMP DO schedule(static) private(jk, jj, ji)271 241 DO jk = 2, jpkm1 272 242 DO jj = 2, jpjm1, MAX(1, jpj3) ! rows jj=2 and =jpjm1 only … … 313 283 ! ===========================  wslpj = mij( d/dj( prd ) / d/dz( prd ) 314 284 ! 315 !$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj)316 285 DO jk = 2, jpkm1 317 286 DO jj = 2, jpjm1 … … 349 318 END DO 350 319 END DO 351 !$OMP END PARALLEL352 320 CALL lbc_lnk( zwz, 'T', 1. ) ; CALL lbc_lnk( zww, 'T', 1. ) ! lateral boundary conditions 353 321 ! 354 322 ! !* horizontal Shapiro filter 355 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck)356 323 DO jk = 2, jpkm1 357 324 DO jj = 2, jpjm1, MAX(1, jpj3) ! rows jj=2 and =jpjm1 only … … 703 670 z1_slpmax = 1._wp / rn_slpmax 704 671 ! 705 !$OMP PARALLEL 706 !$OMP DO schedule(static) private(jj) 707 DO jj = 1, jpj 708 uslpml (1,jj) = 0._wp ; uslpml (jpi,jj) = 0._wp 709 vslpml (1,jj) = 0._wp ; vslpml (jpi,jj) = 0._wp 710 wslpiml(1,jj) = 0._wp ; wslpiml(jpi,jj) = 0._wp 711 wslpjml(1,jj) = 0._wp ; wslpjml(jpi,jj) = 0._wp 712 END DO 672 uslpml (1,:) = 0._wp ; uslpml (jpi,:) = 0._wp 673 vslpml (1,:) = 0._wp ; vslpml (jpi,:) = 0._wp 674 wslpiml(1,:) = 0._wp ; wslpiml(jpi,:) = 0._wp 675 wslpjml(1,:) = 0._wp ; wslpjml(jpi,:) = 0._wp 713 676 ! 714 677 ! !== surface mixed layer mask ! 715 !$OMP DO schedule(static) private(jk, jj, ji, ik)716 678 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 717 679 DO jj = 1, jpj … … 724 686 END DO 725 687 END DO 726 !$OMP END DO NOWAIT727 688 728 689 … … 737 698 ! 738 699 ! 739 !$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)740 700 DO jj = 2, jpjm1 741 701 DO ji = 2, jpim1 … … 782 742 END DO 783 743 END DO 784 !$OMP END PARALLEL785 744 !!gm this lbc_lnk should be useless.... 786 745 CALL lbc_lnk( uslpml , 'U', 1. ) ; CALL lbc_lnk( vslpml , 'V', 1. ) ! lateral boundary cond. (sign change) … … 832 791 ! Direction of lateral diffusion (tracers and/or momentum) 833 792 !  834 835 !$OMP PARALLEL 836 !$OMP DO schedule(static) private(jk, jj, ji) 837 DO jk = 1, jpk 838 DO jj = 1, jpj 839 DO ji = 1, jpi 840 uslp (ji,jj,jk) = 0._wp 841 vslp (ji,jj,jk) = 0._wp 842 wslpi(ji,jj,jk) = 0._wp 843 wslpj(ji,jj,jk) = 0._wp 844 END DO 845 END DO 846 END DO 847 !$OMP END DO NOWAIT 848 !$OMP DO schedule(static) private(jj, ji) 849 DO jj = 1, jpj 850 DO ji = 1, jpi 851 uslpml (ji,jj) = 0._wp 852 vslpml (ji,jj) = 0._wp 853 wslpiml(ji,jj) = 0._wp 854 wslpjml(ji,jj) = 0._wp 855 END DO 856 END DO 857 !$OMP END PARALLEL 793 uslp (:,:,:) = 0._wp ; uslpml (:,:) = 0._wp ! set the slope to zero (even in scoordinates) 794 vslp (:,:,:) = 0._wp ; vslpml (:,:) = 0._wp 795 wslpi(:,:,:) = 0._wp ; wslpiml(:,:) = 0._wp 796 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 797 858 798 !!gm I no longer understand this..... 859 799 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r7698 r7753 116 116 !! aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 117 117 !! 118 INTEGER :: jk , jj, ji! dummy loop indices118 INTEGER :: jk ! dummy loop indices 119 119 INTEGER :: ierr, inum, ios ! local integer 120 120 REAL(wp) :: zah0 ! local scalar … … 184 184 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 185 185 ! 186 !$OMP PARALLEL DO schedule(static) private(jj, ji) 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 ahtu(ji,jj,jpk) = 0._wp ! last level always 0 190 ahtv(ji,jj,jpk) = 0._wp 191 END DO 192 END DO 186 ahtu(:,:,jpk) = 0._wp ! last level always 0 187 ahtv(:,:,jpk) = 0._wp 193 188 ! 194 189 ! ! value of eddy mixing coef. … … 205 200 CASE( 0 ) !== constant ==! 206 201 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant = ', rn_aht_0 207 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 208 DO jk = 1, jpk 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 ahtu(ji,jj,jk) = zah0 * umask(ji,jj,jk) 212 ahtv(ji,jj,jk) = zah0 * vmask(ji,jj,jk) 213 END DO 214 END DO 215 END DO 202 ahtu(:,:,:) = zah0 * umask(:,:,:) 203 ahtv(:,:,:) = zah0 * vmask(:,:,:) 216 204 ! 217 205 CASE( 10 ) !== fixed profile ==! 218 206 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 ahtu(ji,jj,1) = zah0 * umask(ji,jj,1) ! constant surface value 223 ahtv(ji,jj,1) = zah0 * vmask(ji,jj,1) 224 END DO 225 END DO 207 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 208 ahtv(:,:,1) = zah0 * vmask(:,:,1) 226 209 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 227 210 ! … … 232 215 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 233 216 CALL iom_close( inum ) 234 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)235 217 DO jk = 2, jpkm1 236 DO jj = 1, jpj 237 DO ji = 1, jpi 238 ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 239 ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 240 END DO 241 END DO 218 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 219 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 242 220 END DO 243 221 ! … … 266 244 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 267 245 CALL iom_close( inum ) 268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)269 246 DO jk = 1, jpkm1 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 ahtu(ji,jj,jk) = ahtu(ji,jj,jk) * umask(ji,jj,jk) 273 ahtv(ji,jj,jk) = ahtv(ji,jj,jk) * vmask(ji,jj,jk) 274 END DO 275 END DO 247 ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 248 ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 276 249 END DO 277 250 ! … … 294 267 ! 295 268 IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 296 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 297 DO jk = 1, jpk 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 ahtu(ji,jj,jk) = SQRT( ahtu(ji,jj,jk) ) 301 ahtv(ji,jj,jk) = SQRT( ahtv(ji,jj,jk) ) 302 END DO 303 END DO 304 END DO 269 ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 270 ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 305 271 ENDIF 306 272 ! … … 347 313 ! ! increase to rn_aht_0 within 20N20S 348 314 IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN ! use the already computed aei. 349 !$OMP PARALLEL DO schedule(static) private(jj,ji) 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 ahtu(ji,jj,1) = aeiu(ji,jj,1) 353 ahtv(ji,jj,1) = aeiv(ji,jj,1) 354 END DO 355 END DO 315 ahtu(:,:,1) = aeiu(:,:,1) 316 ahtv(:,:,1) = aeiv(:,:,1) 356 317 ELSE ! compute aht. 357 318 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) … … 360 321 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 361 322 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 362 !$OMP PARALLEL363 !$OMP DO schedule(static) private(jj,ji,zaht,zahf)364 323 DO jj = 1, jpj 365 324 DO ji = 1, jpi … … 372 331 END DO 373 332 END DO 374 !$OMP DO schedule(static) private(jk,jj,ji)375 333 DO jk = 2, jpkm1 ! deeper value = surface value 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 379 ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 380 END DO 381 END DO 382 END DO 383 !$OMP END PARALLEL 334 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 335 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 336 END DO 384 337 ! 385 338 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 386 339 IF( ln_traldf_lap ) THEN ! laplacian operator u e /12 387 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)388 340 DO jk = 1, jpkm1 389 DO jj = 1, jpj 390 DO ji = 1, jpi 391 ahtu(ji,jj,jk) = ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 392 ahtv(ji,jj,jk) = ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 393 END DO 394 END DO 341 ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 342 ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 395 343 END DO 396 344 ELSEIF( ln_traldf_blp ) THEN ! bilaplacian operator sqrt( u e^3 /12 ) = sqrt( u e /12 ) * e 397 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)398 345 DO jk = 1, jpkm1 399 DO jj = 1, jpj 400 DO ji = 1, jpi 401 ahtu(ji,jj,jk) = SQRT( ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 ) * e1u(ji,jj) 402 ahtv(ji,jj,jk) = SQRT( ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 ) * e2v(ji,jj) 403 END DO 404 END DO 346 ahtu(:,:,jk) = SQRT( ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 ) * e1u(:,:) 347 ahtv(:,:,jk) = SQRT( ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 ) * e2v(:,:) 405 348 END DO 406 349 ENDIF … … 435 378 !! l_ldfeiv_time : =T if EIV coefficients vary with time 436 379 !! 437 INTEGER :: jk , jj, ji! dummy loop indices380 INTEGER :: jk ! dummy loop indices 438 381 INTEGER :: ierr, inum, ios ! local integer 439 382 ! … … 476 419 CASE( 0 ) !== constant ==! 477 420 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = constant = ', rn_aeiv_0 478 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 479 DO jk = 1, jpk 480 DO jj = 1, jpj 481 DO ji = 1, jpi 482 aeiu(ji,jj,jk) = rn_aeiv_0 483 aeiv(ji,jj,jk) = rn_aeiv_0 484 END DO 485 END DO 486 END DO 421 aeiu(:,:,:) = rn_aeiv_0 422 aeiv(:,:,:) = rn_aeiv_0 487 423 ! 488 424 CASE( 10 ) !== fixed profile ==! 489 425 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = F( depth )' 490 !$OMP PARALLEL DO schedule(static) private(jj, ji) 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 aeiu(ji,jj,1) = rn_aeiv_0 ! constant surface value 494 aeiv(ji,jj,1) = rn_aeiv_0 495 END DO 496 END DO 426 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 427 aeiv(:,:,1) = rn_aeiv_0 497 428 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 498 429 ! … … 503 434 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 504 435 CALL iom_close( inum ) 505 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)506 436 DO jk = 2, jpk 507 DO jj = 1, jpj 508 DO ji = 1, jpi 509 aeiu(ji,jj,jk) = aeiu(ji,jj,1) 510 aeiv(ji,jj,jk) = aeiv(ji,jj,1) 511 END DO 512 END DO 437 aeiu(:,:,jk) = aeiu(:,:,1) 438 aeiv(:,:,jk) = aeiv(:,:,1) 513 439 END DO 514 440 ! … … 572 498 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 573 499 ! 574 !$OMP PARALLEL DO schedule(static) private(jj,ji) 575 DO jj = 1, jpj 576 DO ji = 1, jpi 577 zn (ji,jj) = 0._wp ! Local initialization 578 zhw (ji,jj) = 5._wp 579 zah (ji,jj) = 0._wp 580 zross(ji,jj) = 0._wp 581 END DO 582 END DO 500 zn (:,:) = 0._wp ! Local initialization 501 zhw (:,:) = 5._wp 502 zah (:,:) = 0._wp 503 zross(:,:) = 0._wp 583 504 ! ! Compute lateral diffusive coefficient at Tpoint 584 505 IF( ln_traldf_triad ) THEN 585 506 DO jk = 1, jpk 586 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w)587 507 DO jj = 2, jpjm1 588 508 DO ji = 2, jpim1 … … 603 523 ELSE 604 524 DO jk = 1, jpk 605 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w)606 525 DO jj = 2, jpjm1 607 526 DO ji = 2, jpim1 … … 623 542 END IF 624 543 625 !$OMP PARALLEL626 !$OMP DO schedule(static) private(jj,ji,zfw)627 544 DO jj = 2, jpjm1 628 545 DO ji = fs_2, fs_jpim1 ! vector opt. … … 637 554 ! !== Bound on eiv coeff. ==! 638 555 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 639 !$OMP DO schedule(static) private(jj,ji,zzaei)640 556 DO jj = 2, jpjm1 641 557 DO ji = fs_2, fs_jpim1 ! vector opt. … … 644 560 END DO 645 561 END DO 646 !$OMP END PARALLEL647 562 CALL lbc_lnk( zaeiw(:,:), 'W', 1. ) ! lateral boundary condition 648 563 ! 649 !$OMP PARALLEL DO schedule(static) private(jj,ji)650 564 DO jj = 2, jpjm1 !== aei at u and vpoints ==! 651 565 DO ji = fs_2, fs_jpim1 ! vector opt. … … 656 570 CALL lbc_lnk( paeiu(:,:,1), 'U', 1. ) ; CALL lbc_lnk( paeiv(:,:,1), 'V', 1. ) ! lateral boundary condition 657 571 658 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)659 572 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! 660 DO jj = 1, jpj 661 DO ji = 1, jpi 662 paeiu(ji,jj,jk) = paeiu(ji,jj,1) * umask(ji,jj,jk) 663 paeiv(ji,jj,jk) = paeiv(ji,jj,1) * vmask(ji,jj,jk) 664 END DO 665 END DO 573 paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 574 paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 666 575 END DO 667 576 ! … … 715 624 716 625 717 !$OMP PARALLEL 718 !$OMP DO schedule(static) private(jj,ji) 719 DO jj = 1, jpj 720 DO ji = 1, jpi 721 zpsi_uw(ji,jj, 1 ) = 0._wp ; zpsi_vw(ji,jj, 1 ) = 0._wp 722 zpsi_uw(ji,jj,jpk) = 0._wp ; zpsi_vw(ji,jj,jpk) = 0._wp 723 END DO 724 END DO 725 !$OMP END DO NOWAIT 726 ! 727 !$OMP DO schedule(static) private(jk,jj,ji) 626 zpsi_uw(:,:, 1 ) = 0._wp ; zpsi_vw(:,:, 1 ) = 0._wp 627 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 628 ! 728 629 DO jk = 2, jpkm1 729 630 DO jj = 1, jpjm1 … … 737 638 END DO 738 639 ! 739 !$OMP DO schedule(static) private(jk,jj,ji)740 640 DO jk = 1, jpkm1 741 641 DO jj = 1, jpjm1 … … 746 646 END DO 747 647 END DO 748 !$OMP END DO NOWAIT749 !$OMP DO schedule(static) private(jk,jj,ji)750 648 DO jk = 1, jpkm1 751 649 DO jj = 2, jpjm1 … … 756 654 END DO 757 655 END DO 758 !$OMP END PARALLEL759 656 ! 760 657 ! ! diagnose the eddy induced velocity and associated heat transport … … 798 695 CALL wrk_alloc( jpi,jpj,jpk, zw3d ) 799 696 ! 800 !$OMP PARALLEL 801 !$OMP DO schedule(static) private(jj,ji) 802 DO jj = 1, jpj 803 DO ji = 1, jpi 804 zw3d(ji,jj,jpk) = 0._wp ! bottom value always 0 805 END DO 806 END DO 807 !$OMP END DO NOWAIT 808 ! 809 !$OMP DO schedule(static) private(jk,jj,ji) 697 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 698 ! 810 699 DO jk = 1, jpkm1 ! e2u e3u u_eiv = dk[psi_uw] 811 DO jj = 1, jpj 812 DO ji = 1, jpi 813 zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1)  psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 814 END DO 815 END DO 816 END DO 817 !$OMP END PARALLEL 700 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1)  psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 701 END DO 818 702 CALL iom_put( "uoce_eiv", zw3d ) 819 703 ! 820 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)821 704 DO jk = 1, jpkm1 ! e1v e3v v_eiv = dk[psi_vw] 822 DO jj = 1, jpj 823 DO ji = 1, jpi 824 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1)  psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 825 END DO 826 END DO 705 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1)  psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 827 706 END DO 828 707 CALL iom_put( "voce_eiv", zw3d ) 829 708 ! 830 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)831 709 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 832 710 DO jj = 2, jpjm1 … … 846 724 zztmp = 0.5_wp * rau0 * rcp 847 725 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 848 !$OMP PARALLEL 849 !$OMP DO schedule(static) private(jj,ji) 850 DO jj = 1, jpj 851 DO ji = 1, jpi 852 zw2d(ji,jj) = 0._wp 853 END DO 854 END DO 855 !$OMP DO schedule(static) private(jk,jj,ji) 856 DO jk = 1, jpk 857 DO jj = 1, jpj 858 DO ji = 1, jpi 859 zw3d(ji,jj,jk) = 0._wp 860 END DO 861 END DO 862 END DO 863 DO jk = 1, jpkm1 864 !$OMP DO schedule(static) private(jj,ji) 865 DO jj = 2, jpjm1 866 DO ji = fs_2, fs_jpim1 ! vector opt. 867 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)  psi_uw(ji,jj,jk) ) & 868 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 869 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 870 END DO 871 END DO 872 END DO 873 !$OMP END PARALLEL 874 CALL lbc_lnk( zw2d, 'U', 1. ) 875 CALL lbc_lnk( zw3d, 'U', 1. ) 876 CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in idirection 877 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in idirection 878 ENDIF 879 !$OMP PARALLEL 880 !$OMP DO schedule(static) private(jj,ji) 881 DO jj = 1, jpj 882 DO ji = 1, jpi 883 zw2d(ji,jj) = 0._wp 884 END DO 885 END DO 886 !$OMP DO schedule(static) private(jk,jj,ji) 887 DO jk = 1, jpk 888 DO jj = 1, jpj 889 DO ji = 1, jpi 890 zw3d(ji,jj,jk) = 0._wp 891 END DO 892 END DO 893 END DO 726 zw2d(:,:) = 0._wp 727 zw3d(:,:,:) = 0._wp 728 DO jk = 1, jpkm1 729 DO jj = 2, jpjm1 730 DO ji = fs_2, fs_jpim1 ! vector opt. 731 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)  psi_uw(ji,jj,jk) ) & 732 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 733 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 734 END DO 735 END DO 736 END DO 737 CALL lbc_lnk( zw2d, 'U', 1. ) 738 CALL lbc_lnk( zw3d, 'U', 1. ) 739 CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in idirection 740 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in idirection 741 ENDIF 742 zw2d(:,:) = 0._wp 743 zw3d(:,:,:) = 0._wp 894 744 DO jk = 1, jpkm1 895 !$OMP DO schedule(static) private(jj,ji)896 745 DO jj = 2, jpjm1 897 746 DO ji = fs_2, fs_jpim1 ! vector opt. … … 902 751 END DO 903 752 END DO 904 !$OMP END PARALLEL905 753 CALL lbc_lnk( zw2d, 'V', 1. ) 906 754 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in jdirection … … 911 759 zztmp = 0.5_wp * 0.5 912 760 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 913 !$OMP PARALLEL 914 !$OMP DO schedule(static) private(jj,ji) 915 DO jj = 1, jpj 916 DO ji = 1, jpi 917 zw2d(ji,jj) = 0._wp 918 END DO 919 END DO 920 !$OMP DO schedule(static) private(jk,jj,ji) 921 DO jk = 1, jpk 922 DO jj = 1, jpj 923 DO ji = 1, jpi 924 zw3d(ji,jj,jk) = 0._wp 925 END DO 926 END DO 927 END DO 928 DO jk = 1, jpkm1 929 !$OMP DO schedule(static) private(jj,ji) 930 DO jj = 2, jpjm1 931 DO ji = fs_2, fs_jpim1 ! vector opt. 932 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)  psi_uw(ji,jj,jk) ) & 933 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji+1,jj,jk,jp_sal) ) 934 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 935 END DO 936 END DO 937 END DO 938 CALL lbc_lnk( zw2d, 'U', 1. ) 939 CALL lbc_lnk( zw3d, 'U', 1. ) 940 CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in idirection 941 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in idirection 942 !$OMP END PARALLEL 943 ENDIF 944 !$OMP PARALLEL 945 !$OMP DO schedule(static) private(jj,ji) 946 DO jj = 1, jpj 947 DO ji = 1, jpi 948 zw2d(ji,jj) = 0._wp 949 END DO 950 END DO 951 !$OMP DO schedule(static) private(jk,jj,ji) 952 DO jk = 1, jpk 953 DO jj = 1, jpj 954 DO ji = 1, jpi 955 zw3d(ji,jj,jk) = 0._wp 956 END DO 957 END DO 958 END DO 761 zw2d(:,:) = 0._wp 762 zw3d(:,:,:) = 0._wp 763 DO jk = 1, jpkm1 764 DO jj = 2, jpjm1 765 DO ji = fs_2, fs_jpim1 ! vector opt. 766 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)  psi_uw(ji,jj,jk) ) & 767 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji+1,jj,jk,jp_sal) ) 768 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 769 END DO 770 END DO 771 END DO 772 CALL lbc_lnk( zw2d, 'U', 1. ) 773 CALL lbc_lnk( zw3d, 'U', 1. ) 774 CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in idirection 775 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in idirection 776 ENDIF 777 zw2d(:,:) = 0._wp 778 zw3d(:,:,:) = 0._wp 959 779 DO jk = 1, jpkm1 960 !$OMP DO schedule(static) private(jj,ji)961 780 DO jj = 2, jpjm1 962 781 DO ji = fs_2, fs_jpim1 ! vector opt. … … 967 786 END DO 968 787 END DO 969 !$OMP END PARALLEL970 788 CALL lbc_lnk( zw2d, 'V', 1. ) 971 789 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in jdirection
Note: See TracChangeset
for help on using the changeset viewer.