Changeset 13819
- Timestamp:
- 2020-11-18T19:02:11+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling
- Files:
-
- 33 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ASM/asminc.F90
r13518 r13819 26 26 USE par_oce ! Ocean space and time domain variables 27 27 USE dom_oce ! Ocean space and time domain 28 USE domain, ONLY : dom_tile 28 29 USE domvvl ! domain: variable volume level 29 30 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients … … 518 519 ! 519 520 INTEGER :: ji, jj, jk 520 INTEGER :: it 521 INTEGER :: it, itile 521 522 REAL(wp) :: zincwgt ! IAU weight for current time step 522 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values523 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 523 524 !!---------------------------------------------------------------------- 524 525 ! 525 526 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 527 ! used to prevent the applied increments taking the temperature below the local freezing point 527 ! TODO: NOT TESTED- logical is forced to False528 528 IF( ln_temnofreeze ) THEN 529 529 DO jk = 1, jpkm1 … … 550 550 ! 551 551 ! Update the tracer tendencies 552 ! TODO: NOT TESTED- logical is forced to False553 552 DO jk = 1, jpkm1 554 553 IF (ln_temnofreeze) THEN 555 554 ! Do not apply negative increments if the temperature will fall below freezing 556 WHERE(t_bkginc( ST_2D(0),jk) > 0.0_wp .OR. &557 & pts( ST_2D(0),jk,jp_tem,Kmm) + pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) )558 pts( ST_2D(0),jk,jp_tem,Krhs) = pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * zincwgt555 WHERE(t_bkginc(A2D(0),jk) > 0.0_wp .OR. & 556 & pts(A2D(0),jk,jp_tem,Kmm) + pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 557 pts(A2D(0),jk,jp_tem,Krhs) = pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * zincwgt 559 558 END WHERE 560 559 ELSE … … 566 565 ! Do not apply negative increments if the salinity will fall below a specified 567 566 ! minimum value salfixmin 568 WHERE(s_bkginc( ST_2D(0),jk) > 0.0_wp .OR. &569 & pts( ST_2D(0),jk,jp_sal,Kmm) + pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * wgtiau(it) > salfixmin )570 pts( ST_2D(0),jk,jp_sal,Krhs) = pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * zincwgt567 WHERE(s_bkginc(A2D(0),jk) > 0.0_wp .OR. & 568 & pts(A2D(0),jk,jp_sal,Kmm) + pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * wgtiau(it) > salfixmin ) 569 pts(A2D(0),jk,jp_sal,Krhs) = pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * zincwgt 571 570 END WHERE 572 571 ELSE … … 594 593 ! 595 594 ! Initialize the now fields with the background + increment 596 ! TODO: NOT TESTED- logical is forced to False597 595 IF (ln_temnofreeze) THEN 598 596 ! Do not apply negative increments if the temperature will fall below freezing 599 WHERE( t_bkginc( ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_tem,Kmm) + t_bkginc(ST_2D(0),:) > fzptnz(:,:,:) )600 pts( ST_2D(0),:,jp_tem,Kmm) = t_bkg(ST_2D(0),:) + t_bkginc(ST_2D(0),:)597 WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) ) 598 pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:) 601 599 END WHERE 602 600 ELSE … … 608 606 ! Do not apply negative increments if the salinity will fall below a specified 609 607 ! minimum value salfixmin 610 WHERE( s_bkginc( ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_sal,Kmm) + s_bkginc(ST_2D(0),:) > salfixmin )611 pts( ST_2D(0),:,jp_sal,Kmm) = s_bkg(ST_2D(0),:) + s_bkginc(ST_2D(0),:)608 WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin ) 609 pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:) 612 610 END WHERE 613 611 ELSE … … 626 624 !!gm 627 625 628 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*)626 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 629 627 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 628 itile = ntile 629 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 630 630 631 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 631 632 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient … … 634 635 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 635 636 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 637 638 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 636 639 ENDIF 637 640 … … 646 649 ! 647 650 ENDIF 648 ! TODO: NOT TESTED- logical is forced to False649 651 ! Perhaps the following call should be in step 650 652 IF ( ln_seaiceinc ) CALL seaice_asm_inc ( kt ) ! apply sea ice concentration increment … … 859 861 REAL(wp) :: zincwgt ! IAU weight for current time step 860 862 #if defined key_si3 861 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc863 REAL(wp), DIMENSION(A2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc 862 864 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres 863 865 #endif … … 897 899 ! 898 900 ! Nudge sea ice depth to bring it up to a required minimum depth 899 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( ST_2D(0)) < zhicifmin )900 zhicifinc(:,:) = (zhicifmin - hm_i( ST_2D(0))) * zincwgt901 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 902 zhicifinc(:,:) = (zhicifmin - hm_i(A2D(0))) * zincwgt 901 903 ELSEWHERE 902 904 zhicifinc(:,:) = 0.0_wp … … 957 959 ! 958 960 ! Nudge sea ice depth to bring it up to a required minimum depth 959 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( ST_2D(0)) < zhicifmin )960 zhicifinc(:,:) = zhicifmin - hm_i( ST_2D(0))961 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 962 zhicifinc(:,:) = zhicifmin - hm_i(A2D(0)) 961 963 ELSEWHERE 962 964 zhicifinc(:,:) = 0.0_wp -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/BDY/bdytra.F90
r13553 r13819 157 157 INTEGER :: ib_bdy ! Loop index 158 158 !!---------------------------------------------------------------------- 159 ! TODO: TO BE TILED160 ! TODO: NOT TESTED- requires bdy161 ! NOTE: Tiling these BDY loops is nontrivial; IF statements to check whether a point is in the current tile won't work (will be for every ib, every tile). The idx_bdy structure might require modifying to include a %nblen and list of ib indices for the current tile.162 159 IF( ntile /= 0 .AND. ntile /= 1 ) RETURN ! Do only for the full domain 163 160 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA/diaar5.F90
r13553 r13819 306 306 END SUBROUTINE dia_ar5 307 307 308 ! TEMP: These changes not necessary if using XIOS (subdomain support, will not output haloes)308 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support, will not output haloes) 309 309 SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 310 310 !!---------------------------------------------------------------------- … … 316 316 INTEGER , INTENT(in ) :: ktra ! tracer index 317 317 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 318 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) , INTENT(in) :: puflx ! u-flux of advection/diffusion319 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion318 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: puflx ! u-flux of advection/diffusion 319 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion 320 320 ! 321 321 INTEGER :: ji, jj, jk -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA/diaptr.F90
r13741 r13819 22 22 USE oce ! ocean dynamics and active tracers 23 23 USE dom_oce ! ocean space and time domain 24 ! TEMP: Possibly not necessary if using XIOS (if cumulative axis operations are possible)25 24 USE domain, ONLY : dom_tile 26 25 USE phycst ! physical constants … … 72 71 CONTAINS 73 72 74 ! TEMP: Most changes and some code in this module not necessary if using XIOS (subdomain support, axis operations)75 73 SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 76 74 !!---------------------------------------------------------------------- … … 79 77 INTEGER , INTENT(in) :: kt ! ocean time-step index 80 78 INTEGER , INTENT(in) :: Kmm ! time level index 81 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport79 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport 82 80 !!---------------------------------------------------------------------- 83 81 ! … … 111 109 INTEGER , INTENT(in) :: kt ! ocean time-step index 112 110 INTEGER , INTENT(in) :: Kmm ! time level index 113 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport111 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport 114 112 ! 115 113 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 136 134 z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn) ! effective j-Stream-Function (MSF) 137 135 END DO 138 DO ji = 1, jpi136 DO ji = 2, jpi 139 137 z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 140 138 ENDDO … … 162 160 DO jn = 1, nbasin 163 161 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 164 DO ji = 1, jpi162 DO ji = 2, jpi 165 163 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 166 164 ENDDO … … 169 167 DO jn = 1, nbasin 170 168 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 171 DO ji = 1, jpi169 DO ji = 2, jpi 172 170 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 173 171 ENDDO … … 196 194 DO jn = 1, nbasin 197 195 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 198 ! TODO: Change these loop indices in the next commit 199 DO ji = 1, jpi 196 DO ji = 2, jpi 200 197 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 201 198 ENDDO … … 204 201 DO jn = 1, nbasin 205 202 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 206 DO ji = 1, jpi203 DO ji = 2, jpi 207 204 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 208 205 ENDDO … … 252 249 DO jn = 1, nbasin 253 250 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 254 DO ji = 1, jpi251 DO ji = 2, jpi 255 252 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 256 253 ENDDO … … 259 256 DO jn = 1, nbasin 260 257 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 261 DO ji = 1, jpi258 DO ji = 2, jpi 262 259 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 263 260 ENDDO … … 270 267 DO jn = 1, nbasin 271 268 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 272 DO ji = 1, jpi269 DO ji = 2, jpi 273 270 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 274 271 ENDDO … … 277 274 DO jn = 1, nbasin 278 275 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 279 DO ji = 1, jpi276 DO ji = 2, jpi 280 277 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 281 278 ENDDO … … 288 285 DO jn = 1, nbasin 289 286 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 290 DO ji = 1, jpi287 DO ji = 2, jpi 291 288 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 292 289 ENDDO … … 295 292 DO jn = 1, nbasin 296 293 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 297 DO ji = 1, jpi294 DO ji = 2, jpi 298 295 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 299 296 ENDDO … … 305 302 DO jn = 1, nbasin 306 303 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 307 DO ji = 1, jpi304 DO ji = 2, jpi 308 305 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 309 306 ENDDO … … 312 309 DO jn = 1, nbasin 313 310 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 314 DO ji = 1, jpi311 DO ji = 2, jpi 315 312 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 316 313 ENDDO … … 319 316 ENDIF 320 317 ! 321 ! TEMP: Possibly not necessary if using XIOS (if cumulative axis operations are possible)322 ! TODO: NOT TESTED- hangs on iom_get_var323 318 IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 324 319 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain … … 354 349 !!---------------------------------------------------------------------- 355 350 INTEGER , INTENT(in) :: Kmm ! time level index 356 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport351 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 357 352 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! 3D workspace 358 353 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zts ! 4D workspace … … 366 361 ! i sum of effective j transport excluding closed seas 367 362 IF( iom_use( 'zomsf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 368 ALLOCATE( v_msf( ST_1Dj(nn_hls),jpk,nbasin) )363 ALLOCATE( v_msf(A1Dj(nn_hls),jpk,nbasin) ) 369 364 370 365 DO jn = 1, nbasin … … 380 375 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 381 376 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 382 ALLOCATE( zmask( ST_2D(nn_hls),jpk), zts(ST_2D(nn_hls),jpk,jpts), &383 & sjk( ST_1Dj(nn_hls),jpk,nbasin), &384 & zt_jk( ST_1Dj(nn_hls),jpk,nbasin), zs_jk(ST_1Dj(nn_hls),jpk,nbasin) )377 ALLOCATE( zmask(A2D(nn_hls),jpk), zts(A2D(nn_hls),jpk,jpts), & 378 & sjk(A1Dj(nn_hls),jpk,nbasin), & 379 & zt_jk(A1Dj(nn_hls),jpk,nbasin), zs_jk(A1Dj(nn_hls),jpk,nbasin) ) 385 380 386 381 zmask(:,:,:) = 0._wp … … 409 404 ! i sum of j surface area - temperature/salinity product on T grid 410 405 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN 411 ALLOCATE( zmask( ST_2D(nn_hls),jpk), zts(ST_2D(nn_hls),jpk,jpts), &412 & sjk( ST_1Dj(nn_hls),jpk,nbasin), &413 & zt_jk( ST_1Dj(nn_hls),jpk,nbasin), zs_jk(ST_1Dj(nn_hls),jpk,nbasin) )406 ALLOCATE( zmask(A2D(nn_hls),jpk), zts(A2D(nn_hls),jpk,jpts), & 407 & sjk(A1Dj(nn_hls),jpk,nbasin), & 408 & zt_jk(A1Dj(nn_hls),jpk,nbasin), zs_jk(A1Dj(nn_hls),jpk,nbasin) ) 414 409 415 410 zmask(:,:,:) = 0._wp … … 438 433 ! i-k sum of j surface area - temperature/salinity product on V grid 439 434 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 440 ALLOCATE( zts( ST_2D(nn_hls),jpk,jpts) )435 ALLOCATE( zts(A2D(nn_hls),jpk,jpts) ) 441 436 442 437 zts(:,:,:,:) = 0._wp … … 544 539 INTEGER , INTENT(in ) :: ktra ! tracer index 545 540 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 546 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion547 REAL(wp), DIMENSION( ST_1Dj(nn_hls),nbasin) :: zsj !541 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion 542 REAL(wp), DIMENSION(A1Dj(nn_hls),nbasin) :: zsj ! 548 543 INTEGER :: jn ! 549 544 … … 581 576 !!---------------------------------------------------------------------- 582 577 REAL(wp), DIMENSION(jpj,nbasin) , INTENT(inout) :: phstr ! 583 REAL(wp), DIMENSION( ST_1Dj(nn_hls),nbasin), INTENT(in) :: pva !578 REAL(wp), DIMENSION(A1Dj(nn_hls),nbasin), INTENT(in) :: pva ! 584 579 INTEGER :: jj 585 580 #if defined key_mpp_mpi … … 617 612 !!---------------------------------------------------------------------- 618 613 REAL(wp), DIMENSION(jpj,jpk,nbasin) , INTENT(inout) :: phstr ! 619 REAL(wp), DIMENSION( ST_1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva !614 REAL(wp), DIMENSION(A1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva ! 620 615 INTEGER :: jj, jk 621 616 #if defined key_mpp_mpi … … 681 676 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 682 677 !!---------------------------------------------------------------------- 683 REAL(wp), INTENT(in), DIMENSION( ST_2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point678 REAL(wp), INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point 684 679 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 685 680 ! 686 681 INTEGER :: ji, jj, jk ! dummy loop arguments 687 REAL(wp), DIMENSION( ST_1Dj(nn_hls)) :: p_fval ! function value682 REAL(wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 688 683 !!-------------------------------------------------------------------- 689 684 ! … … 706 701 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 707 702 !!---------------------------------------------------------------------- 708 REAL(wp) , INTENT(in), DIMENSION( ST_2D(nn_hls)) :: pvflx ! mask flux array at V-point703 REAL(wp) , INTENT(in), DIMENSION(A2D(nn_hls)) :: pvflx ! mask flux array at V-point 709 704 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 710 705 ! 711 706 INTEGER :: ji,jj ! dummy loop arguments 712 REAL(wp), DIMENSION( ST_1Dj(nn_hls)) :: p_fval ! function value707 REAL(wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 713 708 !!-------------------------------------------------------------------- 714 709 ! … … 760 755 !! 761 756 IMPLICIT none 762 REAL(wp) , INTENT(in), DIMENSION( ST_2D(nn_hls),jpk) :: pta ! mask flux array at V-point757 REAL(wp) , INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pta ! mask flux array at V-point 763 758 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 764 759 !! 765 760 INTEGER :: ji, jj, jk ! dummy loop arguments 766 REAL(wp), DIMENSION( ST_1Dj(nn_hls),jpk) :: p_fval ! return function value761 REAL(wp), DIMENSION(A1Dj(nn_hls),jpk) :: p_fval ! return function value 767 762 !!-------------------------------------------------------------------- 768 763 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/dtatsd.F90
r13745 r13819 137 137 !!---------------------------------------------------------------------- 138 138 INTEGER , INTENT(in ) :: kt ! ocean time-step 139 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data139 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 140 140 ! 141 141 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies … … 155 155 ! 156 156 ! !== ORCA_R2 configuration and T & S damping ==! 157 ! TODO: NOT TESTED- requires orca2158 157 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 159 158 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations … … 184 183 ENDIF 185 184 ! 186 DO_3D( 1, 1, 1, 1, 1, jpk )185 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 187 186 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 188 187 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) … … 227 226 ELSE !== z- or zps- coordinate ==! 228 227 ! 229 DO_3D( 1, 1, 1, 1, 1, jpk )228 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 230 229 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 231 230 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 232 231 END_3D 233 232 ! 234 ! TODO: NOT TESTED- requires zps235 233 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 236 234 DO_2D( 1, 1, 1, 1 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r13741 r13819 729 729 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 730 730 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 731 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components [m3/s]732 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s]733 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s]731 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components [m3/s] 732 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s] 733 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s] 734 734 !! 735 735 INTEGER :: ji, jj, jk ! dummy loop indices 736 736 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 737 737 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 738 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw738 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 739 739 !!---------------------------------------------------------------------- 740 740 ! … … 783 783 !! 784 784 !!---------------------------------------------------------------------- 785 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s]785 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s] 786 786 INTEGER , INTENT(in ) :: Kmm ! ocean time level indices 787 787 ! 788 788 INTEGER :: ji, jj, jk ! dummy loop indices 789 789 REAL(wp) :: zztmp ! local scalar 790 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zw2d ! 2D workspace791 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zw3d ! 3D workspace790 REAL(wp), DIMENSION(A2D(nn_hls)) :: zw2d ! 2D workspace 791 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zw3d ! 3D workspace 792 792 !!---------------------------------------------------------------------- 793 793 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90
r13553 r13819 234 234 !!---------------------------------------------------------------------- 235 235 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 236 REAL(wp), DIMENSION( ST_2DT(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]236 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 237 237 ! ! 2 : salinity [psu] 238 REAL(wp), DIMENSION( ST_2DT(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]239 REAL(wp), DIMENSION( ST_2DT(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m]238 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 239 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 240 240 ! 241 241 INTEGER :: ji, jj, jk ! dummy loop indices … … 334 334 !!---------------------------------------------------------------------- 335 335 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 336 REAL(wp), DIMENSION( ST_2DT(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]336 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 337 337 ! ! 2 : salinity [psu] 338 REAL(wp), DIMENSION( ST_2DT(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]339 REAL(wp), DIMENSION( ST_2DT(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced)340 REAL(wp), DIMENSION( ST_2DT(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m]338 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 339 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 340 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 341 341 ! 342 342 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 500 500 !!---------------------------------------------------------------------- 501 501 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 502 REAL(wp), DIMENSION( ST_2DT(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]502 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 503 503 ! ! 2 : salinity [psu] 504 REAL(wp), DIMENSION( ST_2DT(ktdep) ), INTENT(in ) :: pdep ! depth [m]505 REAL(wp), DIMENSION( ST_2DT(ktrd) ), INTENT( out) :: prd ! in situ density504 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 505 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 506 506 ! 507 507 INTEGER :: ji, jj, jk ! dummy loop indices … … 598 598 INTEGER , INTENT(in ) :: Kmm ! time level index 599 599 INTEGER , INTENT(in ) :: ktts, ktab 600 REAL(wp), DIMENSION( ST_2DT(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity601 REAL(wp), DIMENSION( ST_2DT(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio600 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 602 602 ! 603 603 INTEGER :: ji, jj, jk ! dummy loop indices … … 714 714 INTEGER , INTENT(in ) :: Kmm ! time level index 715 715 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 716 REAL(wp), DIMENSION( ST_2DT(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity717 REAL(wp), DIMENSION( ST_2DT(ktdep) ), INTENT(in ) :: pdep ! depth [m]718 REAL(wp), DIMENSION( ST_2DT(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio716 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 717 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 718 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 719 719 ! 720 720 INTEGER :: ji, jj, jk ! dummy loop indices … … 937 937 INTEGER , INTENT(in ) :: ktab, ktn2 938 938 REAL(wp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 939 REAL(wp), DIMENSION( ST_2DT(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]940 REAL(wp), DIMENSION( ST_2DT(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]939 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 940 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 941 941 ! 942 942 INTEGER :: ji, jj, jk ! dummy loop indices … … 1047 1047 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu] 1048 1048 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m] 1049 REAL(wp), DIMENSION( ST_2DT(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius]1049 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1050 1050 ! 1051 1051 INTEGER :: ji, jj ! dummy loop indices -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90
r13551 r13819 18 18 USE oce ! ocean dynamics and active tracers 19 19 USE dom_oce ! ocean space and time domain 20 ! TEMP: This change not necessary after trd_tra is tiled andextended haloes development20 ! TEMP: [tiling] This change not necessary after extended haloes development 21 21 USE domain, ONLY : dom_tile 22 22 USE domvvl ! variable vertical scale factors … … 91 91 ! 92 92 INTEGER :: ji, jj, jk ! dummy loop index 93 ! TEMP: This change not necessary and can be ST_2D(nn_hls) if using XIOS (subdomain support)93 ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support) 94 94 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace 95 95 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 96 ! TEMP: This change not necessary after extra haloes development96 ! TEMP: [tiling] This change not necessary after extra haloes development 97 97 LOGICAL :: lskip 98 98 !!---------------------------------------------------------------------- … … 102 102 lskip = .FALSE. 103 103 104 ! TEMP: These changes not necessary if using XIOS (subdomain support)104 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 105 105 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 106 106 ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 107 107 ENDIF 108 108 109 ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*)109 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia) 110 110 IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia ) THEN 111 111 IF( ln_tile ) THEN … … 119 119 IF( .NOT. lskip ) THEN 120 120 ! !== effective transport ==! 121 ! TODO: NOT TESTED- requires waves122 121 IF( ln_wave .AND. ln_sdw ) THEN 123 122 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) … … 134 133 ENDIF 135 134 ! 136 ! TODO: NOT TESTED- requires ztilde137 135 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 138 136 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) … … 148 146 END_2D 149 147 ! 150 ! TEMP: These changes not necessary if using XIOS (subdomain support)148 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 151 149 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 152 & CALL ldf_eiv_trp( kt, nit000, zuu( ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), &150 & CALL ldf_eiv_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 153 151 & 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 154 152 ! 155 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu( ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), &153 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 156 154 & 'TRA', Kmm ) ! add the mle transport (if necessary) 157 155 ! 158 ! TEMP: This change not necessary if using XIOS (subdomain support)156 ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 159 157 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 160 158 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport … … 164 162 ! 165 163 !!gm ??? 166 ! TEMP: This change not necessary if using XIOS (subdomain support)167 CALL dia_ptr( kt, Kmm, zvv( ST_2D(nn_hls),:) ) ! diagnose the effective MSF164 ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 165 CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF 168 166 !!gm ??? 169 167 ! … … 200 198 ENDIF 201 199 202 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*)200 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia) 203 201 IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 204 202 … … 208 206 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 209 207 210 ! TEMP: This change not necessary if using XIOS (subdomain support)208 ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 211 209 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 212 210 DEALLOCATE( zuu, zvv, zww ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90
r13553 r13819 71 71 INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme) 72 72 INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme) 73 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)73 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 74 74 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 75 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 79 79 REAL(wp) :: zC2t_u, zC4t_u ! local scalars 80 80 REAL(wp) :: zC2t_v, zC4t_v ! - - 81 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwx, zwy, zwz, ztu, ztv, ztw81 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zwy, zwz, ztu, ztv, ztw 82 82 !!---------------------------------------------------------------------- 83 83 ! … … 153 153 ! 154 154 IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask) 155 ! TODO: NOT TESTED- requires isf156 155 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 157 156 DO_2D( 1, 1, 1, 1 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90
r13553 r13819 79 79 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 80 80 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 81 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)81 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 82 82 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 83 83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 87 87 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 88 88 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 89 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw89 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 90 90 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry 91 91 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup … … 122 122 ! 123 123 IF( l_trd .OR. l_hst ) THEN 124 ALLOCATE( ztrdx( ST_2D(nn_hls),jpk), ztrdy(ST_2D(nn_hls),jpk), ztrdz(ST_2D(nn_hls),jpk) )124 ALLOCATE( ztrdx(A2D(nn_hls),jpk), ztrdy(A2D(nn_hls),jpk), ztrdz(A2D(nn_hls),jpk) ) 125 125 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 126 126 ENDIF 127 127 ! 128 128 IF( l_ptr ) THEN 129 ALLOCATE( zptry( ST_2D(nn_hls),jpk) )129 ALLOCATE( zptry(A2D(nn_hls),jpk) ) 130 130 zptry(:,:,:) = 0._wp 131 131 ENDIF … … 138 138 ! If adaptive vertical advection, check if it is needed on this PE at this time 139 139 IF( ln_zad_Aimp ) THEN 140 IF( MAXVAL( ABS( wi( ST_2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE.140 IF( MAXVAL( ABS( wi(A2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 141 141 END IF 142 142 ! If active adaptive vertical advection, build tridiagonal matrix 143 143 IF( ll_zAimp ) THEN 144 ALLOCATE(zwdia( ST_2D(nn_hls),jpk), zwinf(ST_2D(nn_hls),jpk), zwsup(ST_2D(nn_hls),jpk))144 ALLOCATE(zwdia(A2D(nn_hls),jpk), zwinf(A2D(nn_hls),jpk), zwsup(A2D(nn_hls),jpk)) 145 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 146 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & … … 171 171 END_3D 172 172 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 173 ! TODO: NOT TESTED- requires isf174 173 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 175 174 DO_2D( 1, 1, 1, 1 ) … … 391 390 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 392 391 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field 393 REAL(wp), DIMENSION( ST_2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field394 REAL(wp), DIMENSION( ST_2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions392 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field 393 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 395 394 ! 396 395 INTEGER :: ji, jj, jk ! dummy loop indices … … 398 397 REAL(dp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 399 398 REAL(dp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 400 REAL(dp), DIMENSION( ST_2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo399 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo 401 400 !!---------------------------------------------------------------------- 402 401 ! … … 545 544 !!---------------------------------------------------------------------- 546 545 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point 547 REAL(wp),DIMENSION( ST_2D(nn_hls) ,jpk), INTENT( out) :: pt_out ! field interpolated at w-point546 REAL(wp),DIMENSION(A2D(nn_hls) ,jpk), INTENT( out) :: pt_out ! field interpolated at w-point 548 547 ! 549 548 INTEGER :: ji, jj, jk ! dummy loop integers 550 549 INTEGER :: ikt, ikb ! local integers 551 REAL(wp),DIMENSION( ST_2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt550 REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt 552 551 !!---------------------------------------------------------------------- 553 552 ! … … 569 568 !!gm 570 569 ! 571 ! TODO: NOT TESTED- requires isf572 570 IF ( ln_isfcav ) THEN ! set level two values which may not be set in ISF case 573 571 zwd(:,:,2) = 1._wp ; zwi(:,:,2) = 0._wp ; zws(:,:,2) = 0._wp ; zwrm(:,:,2) = 0._wp … … 635 633 !! The 3d array zwt is used as a work space array. 636 634 !!---------------------------------------------------------------------- 637 REAL(wp),DIMENSION( ST_2D(nn_hls),jpk), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix638 REAL(wp),DIMENSION( ST_2D(nn_hls),jpk), INTENT(in ) :: pRHS ! Right-Hand-Side639 REAL(wp),DIMENSION( ST_2D(nn_hls),jpk), INTENT( out) :: pt_out !!gm field at level=F(klev)635 REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix 636 REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pRHS ! Right-Hand-Side 637 REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT( out) :: pt_out !!gm field at level=F(klev) 640 638 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level 641 639 ! ! =0 pt at t-level 642 640 INTEGER :: ji, jj, jk ! dummy loop integers 643 641 INTEGER :: kstart ! local indices 644 REAL(wp),DIMENSION( ST_2D(nn_hls),jpk) :: zwt ! 3D work array642 REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwt ! 3D work array 645 643 !!---------------------------------------------------------------------- 646 644 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90
r13553 r13819 81 81 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 82 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)83 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 84 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 89 89 REAL(wp) :: zu, z0u, zzwx, zw , zalpha ! local scalars 90 90 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 91 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwx, zslpx ! 3D workspace92 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwy, zslpy ! - -91 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zslpx ! 3D workspace 92 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwy, zslpy ! - - 93 93 !!---------------------------------------------------------------------- 94 94 ! … … 221 221 END_3D 222 222 IF( ln_linssh ) THEN ! top values, linear free surface only 223 ! TODO: NOT TESTED- requires isf224 223 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 225 224 DO_2D( 1, 1, 1, 1 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90
r13553 r13819 91 91 INTEGER , INTENT(in ) :: kjpt ! number of tracers 92 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)93 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 94 94 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 130 130 INTEGER , INTENT(in ) :: kjpt ! number of tracers 131 131 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 132 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)132 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 133 133 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU ! i-velocity components 134 134 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation … … 136 136 INTEGER :: ji, jj, jk, jn ! dummy loop indices 137 137 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 138 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwx, zfu, zfc, zfd138 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zfu, zfc, zfd 139 139 !---------------------------------------------------------------------- 140 140 ! … … 220 220 INTEGER , INTENT(in ) :: kjpt ! number of tracers 221 221 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 222 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)222 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 223 223 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pV ! j-velocity components 224 224 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation … … 226 226 INTEGER :: ji, jj, jk, jn ! dummy loop indices 227 227 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 228 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwy, zfu, zfc, zfd ! 3D workspace228 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwy, zfu, zfc, zfd ! 3D workspace 229 229 !---------------------------------------------------------------------- 230 230 ! … … 318 318 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 319 319 INTEGER , INTENT(in ) :: kjpt ! number of tracers 320 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)320 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 321 321 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity 322 322 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 323 323 ! 324 324 INTEGER :: ji, jj, jk, jn ! dummy loop indices 325 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwz ! 3D workspace325 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwz ! 3D workspace 326 326 !!---------------------------------------------------------------------- 327 327 ! … … 337 337 END_3D 338 338 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 339 ! TODO: NOT TESTED- requires isf340 339 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 341 340 DO_2D( 1, 1, 1, 1 ) … … 368 367 !! ** Method : 369 368 !!---------------------------------------------------------------------- 370 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(in ) :: pfu ! second upwind point371 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(in ) :: pfd ! first douwning point372 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point)373 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux369 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pfu ! second upwind point 370 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pfd ! first douwning point 371 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point) 372 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux 374 373 !! 375 374 INTEGER :: ji, jj, jk ! dummy loop indices -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90
r13553 r13819 92 92 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 93 93 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 94 ! TEMP: This can be ST_2D(nn_hls) if using XIOS (subdomain support)94 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 96 96 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 100 100 REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - 101 101 REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - 102 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace102 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace 103 103 !!---------------------------------------------------------------------- 104 104 ! … … 204 204 END_3D 205 205 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked) 206 ! TODO: NOT TESTED- requires isf207 206 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 208 207 DO_2D( 1, 1, 1, 1 ) … … 282 281 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 283 282 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pbef ! before field 284 REAL(wp), INTENT(inout), DIMENSION( ST_2D(nn_hls) ,jpk) :: paft ! after field285 REAL(wp), INTENT(inout), DIMENSION( ST_2D(nn_hls) ,jpk) :: pcc ! monotonic flux in the k direction283 REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: paft ! after field 284 REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: pcc ! monotonic flux in the k direction 286 285 ! 287 286 INTEGER :: ji, jj, jk ! dummy loop indices 288 287 INTEGER :: ikm1 ! local integer 289 288 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 290 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace289 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace 291 290 !!---------------------------------------------------------------------- 292 291 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90
r13745 r13819 192 192 INTEGER :: ik ! local integers 193 193 REAL(wp) :: zbtr ! local scalars 194 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zptb ! workspace194 REAL(wp), DIMENSION(A2D(nn_hls)) :: zptb ! workspace 195 195 !!---------------------------------------------------------------------- 196 196 ! … … 338 338 REAL(wp) :: za, zb, zgdrho ! local scalars 339 339 REAL(wp) :: zsign, zsigna, zgbbl ! - - 340 REAL(wp), DIMENSION( ST_2D(nn_hls),jpts) :: zts, zab ! 3D workspace341 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace340 REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zts, zab ! 3D workspace 341 REAL(wp), DIMENSION(A2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace 342 342 !!---------------------------------------------------------------------- 343 343 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tradmp.F90
r13551 r13819 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices 97 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk,jpts) :: zts_dta97 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta 98 98 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 99 99 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traisf.F90
r13518 r13819 32 32 CONTAINS 33 33 34 ! TODO: NOT TESTED- requires isf35 34 SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs ) 36 35 !!---------------------------------------------------------------------- … … 90 89 END SUBROUTINE tra_isf 91 90 ! 92 ! TODO: NOT TESTED- requires isf93 91 SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts) 94 92 !!---------------------------------------------------------------------- … … 108 106 INTEGER :: ji,jj,jk ! loop index 109 107 INTEGER :: ikt, ikb ! top and bottom level of the tbl 110 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: ztc ! total ice shelf tracer trend108 REAL(wp), DIMENSION(A2D(nn_hls)) :: ztc ! total ice shelf tracer trend 111 109 !!---------------------------------------------------------------------- 112 110 ! 113 111 ! compute 2d total trend due to isf 114 DO_2D( 1, 1, 1, 1)112 DO_2D( 0, 0, 0, 0 ) 115 113 ztc(ji,jj) = 0.5_wp * ( ptsc(ji,jj,jp_tem) + ptsc_b(ji,jj,jp_tem) ) / phtbl(ji,jj) 116 114 END_2D 117 115 ! 118 116 ! update pts(:,:,:,:,Krhs) 119 DO_2D( 1, 1, 1, 1)117 DO_2D( 0, 0, 0, 0 ) 120 118 ! 121 119 ikt = ktop(ji,jj) … … 134 132 END SUBROUTINE tra_isf_mlt 135 133 ! 136 ! TODO: NOT TESTED- requires isf137 134 SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa ) 138 135 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r13551 r13819 17 17 USE oce ! ocean dynamics and tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)19 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 20 20 USE domain, ONLY : dom_tile 21 21 USE phycst ! physical constants … … 58 58 !! 59 59 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 60 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)60 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 61 61 LOGICAL :: lskip 62 62 !!---------------------------------------------------------------------- … … 72 72 ENDIF 73 73 74 ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)74 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 75 75 IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it ) THEN 76 76 IF( ln_tile ) THEN … … 103 103 ENDIF 104 104 105 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)105 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 106 106 IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 107 107 ENDIF -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90
r13553 r13819 123 123 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 124 124 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 125 REAL(wp), DIMENSION( ST_2DT(ktah) ,JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]126 REAL(wp), DIMENSION( ST_2DT(ktg) ,KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels127 REAL(wp), DIMENSION( ST_2DT(ktgi) ,KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels128 REAL(wp), DIMENSION( ST_2DT(ktt) ,JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)129 REAL(wp), DIMENSION( ST_2DT(ktt2) ,JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)130 REAL(wp), DIMENSION( ST_2DT(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend125 REAL(wp), DIMENSION(A2D_T(ktah) ,JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 126 REAL(wp), DIMENSION(A2D_T(ktg) ,KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 127 REAL(wp), DIMENSION(A2D_T(ktgi) ,KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 128 REAL(wp), DIMENSION(A2D_T(ktt) ,JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 129 REAL(wp), DIMENSION(A2D_T(ktt2) ,JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 130 REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend 131 131 ! 132 132 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 136 136 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 137 137 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 138 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zdkt, zdk1t, z2d139 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zdit, zdjt, zftu, zftv, ztfw138 REAL(wp), DIMENSION(A2D(nn_hls)) :: zdkt, zdk1t, z2d 139 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zdit, zdjt, zftu, zftv, ztfw 140 140 !!---------------------------------------------------------------------- 141 141 ! … … 199 199 IF( ln_traldf_blp ) THEN ! bilaplacian operator 200 200 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 201 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 202 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 201 akz(ji,jj,jk) = 16._wp & 202 & * ah_wslp2 (ji,jj,jk) & 203 & * ( akz (ji,jj,jk) & 204 & + ah_wslp2(ji,jj,jk) & 205 & / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 203 206 END_3D 204 207 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator … … 234 237 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 235 238 END_3D 236 ! TODO: NOT TESTED- requires zps237 239 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 238 240 DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell) … … 240 242 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 241 243 END_2D 242 ! TODO: NOT TESTED- requires isf243 244 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 244 245 DO_2D( 1, 0, 1, 0 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r13553 r13819 96 96 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 97 97 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt_rhs 98 REAL(wp), DIMENSION( ST_2DT(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]99 REAL(wp), DIMENSION( ST_2DT(ktg), KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels100 REAL(wp), DIMENSION( ST_2DT(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels101 REAL(wp), DIMENSION( ST_2DT(ktt), JPK,KJPT), INTENT(in ) :: pt ! before tracer fields102 REAL(wp), DIMENSION( ST_2DT(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend98 REAL(wp), DIMENSION(A2D_T(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 99 REAL(wp), DIMENSION(A2D_T(ktg), KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 100 REAL(wp), DIMENSION(A2D_T(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 101 REAL(wp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! before tracer fields 102 REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend 103 103 ! 104 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 105 105 REAL(wp) :: zsign ! local scalars 106 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: ztu, ztv, zaheeu, zaheev106 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: ztu, ztv, zaheeu, zaheev 107 107 !!---------------------------------------------------------------------- 108 108 ! … … 138 138 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 139 139 END_3D 140 ! TODO: NOT TESTED- requires zps141 140 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 142 141 DO_2D( 1, 0, 1, 0 ) ! bottom … … 144 143 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 145 144 END_2D 146 ! TODO: NOT TESTED- requires isf147 145 IF( ln_isfcav ) THEN ! top in ocean cavities only 148 146 DO_2D( 1, 0, 1, 0 ) … … 201 199 ! 202 200 INTEGER :: ji, jj, jk, jn ! dummy loop indices 203 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk,kjpt) :: zlap ! laplacian at t-point204 REAL(wp), DIMENSION( ST_2D(nn_hls), kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)205 REAL(wp), DIMENSION( ST_2D(nn_hls), kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)201 REAL(wp), DIMENSION(A2D(nn_hls),jpk,kjpt) :: zlap ! laplacian at t-point 202 REAL(wp), DIMENSION(A2D(nn_hls), kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points) 203 REAL(wp), DIMENSION(A2D(nn_hls), kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points) 206 204 !!--------------------------------------------------------------------- 207 205 ! … … 232 230 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 233 231 ! ! Partial top/bottom cell: GRADh( zlap ) 234 ! TODO: NOT TESTED- requires zps and isf235 232 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom 236 233 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, Kmm, kjpt, zlap, zglu, zglv ) ! only bottom -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90
r13553 r13819 13 13 USE oce ! ocean dynamics and active tracers 14 14 USE dom_oce ! ocean space and time domain 15 ! TEMP: This change not necessary if XIOS has subdomain support15 ! TEMP: [tiling] This change not necessary if XIOS has subdomain support 16 16 USE domain, ONLY : dom_tile 17 17 USE domutl, ONLY : is_tile … … 102 102 INTEGER , INTENT(in) :: Kmm ! ocean time level indices 103 103 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 104 REAL(wp), DIMENSION( ST_2DT(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]105 REAL(wp), DIMENSION( ST_2DT(ktg), KJPT), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels106 REAL(wp), DIMENSION( ST_2DT(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels107 REAL(wp), DIMENSION( ST_2DT(ktt), JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)108 REAL(wp), DIMENSION( ST_2DT(ktt2), JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)109 REAL(wp), DIMENSION( ST_2DT(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend104 REAL(wp), DIMENSION(A2D_T(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 105 REAL(wp), DIMENSION(A2D_T(ktg), KJPT), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 106 REAL(wp), DIMENSION(A2D_T(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 107 REAL(wp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 108 REAL(wp), DIMENSION(A2D_T(ktt2), JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 109 REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend 110 110 ! 111 111 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 119 119 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 120 120 REAL(wp) :: zah, zah_slp, zaei_slp 121 REAL(wp), DIMENSION( ST_2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels122 REAL(wp), DIMENSION( ST_2D(nn_hls) ) :: z2d ! 2D workspace123 REAL(wp), DIMENSION( ST_2D(nn_hls) ,jpk) :: zdit, zdjt, zftu, zftv, ztfw ! 3D -124 ! TEMP: This can be ST_2D(nn_hls) if XIOS has subdomain support121 REAL(wp), DIMENSION(A2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 122 REAL(wp), DIMENSION(A2D(nn_hls) ) :: z2d ! 2D workspace 123 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk) :: zdit, zdjt, zftu, zftv, ztfw ! 3D - 124 ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support 125 125 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 126 126 !!---------------------------------------------------------------------- … … 198 198 IF( ln_traldf_blp ) THEN ! bilaplacian operator 199 199 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 200 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 201 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 200 akz(ji,jj,jk) = 16._wp & 201 & * ah_wslp2 (ji,jj,jk) & 202 & * ( akz (ji,jj,jk) & 203 & + ah_wslp2(ji,jj,jk) & 204 & / ( e3w (ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 202 205 END_3D 203 206 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator … … 215 218 ENDIF 216 219 ! 217 ! TEMP: These changes not necessary if XIOS has subdomain support220 ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support 218 221 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 219 222 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN … … 254 257 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 255 258 END_3D 256 ! TODO: NOT TESTED- requires zps257 259 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 258 260 DO_2D( 1, 0, 1, 0 ) ! bottom level … … 260 262 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 261 263 END_2D 262 ! TODO: NOT TESTED- requires isf263 264 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 264 265 DO_2D( 1, 0, 1, 0 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90
r13553 r13819 83 83 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 84 84 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 85 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components86 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pv ! out: same 3 transport components87 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the MLE induced transport85 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components 86 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pv ! out: same 3 transport components 87 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the MLE induced transport 88 88 ! 89 89 INTEGER :: ji, jj, jk ! dummy loop indices … … 91 91 REAL(wp) :: zcuw, zmuw, zc ! local scalar 92 92 REAL(wp) :: zcvw, zmvw ! - - 93 INTEGER , DIMENSION( ST_2D(nn_hls)) :: inml_mle94 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH95 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw96 ! TEMP: These changes not necessary if using XIOS (subdomain support)93 INTEGER , DIMENSION(A2D(nn_hls)) :: inml_mle 94 REAL(wp), DIMENSION(A2D(nn_hls)) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH 95 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 96 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 97 97 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: zLf_NH 98 98 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle … … 213 213 END DO 214 214 215 ! TEMP: These changes not necessary if using XIOS (subdomain support)215 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 216 216 IF( cdtype == 'TRA') THEN !== outputs ==! 217 IF( kt == nit000 .AND. (ntile == 0 .OR. ntile == 1) ) THEN ! Do only on the first tile and timestep217 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 218 218 ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) ) 219 219 zpsiu_mle(:,:,:) = 0._wp ; zpsiv_mle(:,:,:) = 0._wp … … 234 234 CALL iom_put( "psiu_mle", zpsiu_mle ) ! i-mle streamfunction 235 235 CALL iom_put( "psiv_mle", zpsiv_mle ) ! j-mle streamfunction 236 DEALLOCATE( zLf_NH, zpsiu_mle, zpsiv_mle ) 236 237 ENDIF 237 238 ENDIF -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tranpc.F90
r13553 r13819 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed)19 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed) 20 20 USE domain, ONLY : dom_tile 21 21 USE phycst ! physical constants … … 75 75 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... 76 76 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point 77 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk ) :: zn2 ! N^278 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk,jpts) :: zab ! alpha and beta77 REAL(wp), DIMENSION(A2D(nn_hls),jpk ) :: zn2 ! N^2 78 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zab ! alpha and beta 79 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 80 80 ! … … 94 94 ENDIF 95 95 ! 96 ! TODO: NOT TESTED- requires ORCA297 96 IF( l_LB_debug ) THEN 98 97 ! Location of 1 known convection site to follow what's happening in the water column … … 314 313 ENDIF 315 314 ! 316 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed)315 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed) 317 316 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 318 317 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90
r13553 r13819 169 169 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 170 170 ! 171 ALLOCATE( ze0 ( ST_2D(nn_hls)) , ze1 (ST_2D(nn_hls)) , &172 & ze2 ( ST_2D(nn_hls)) , ze3 (ST_2D(nn_hls)) , &173 & ztmp3d( ST_2D(nn_hls),nksr + 1) )171 ALLOCATE( ze0 (A2D(nn_hls)) , ze1 (A2D(nn_hls)) , & 172 & ze2 (A2D(nn_hls)) , ze3 (A2D(nn_hls)) , & 173 & ztmp3d(A2D(nn_hls),nksr + 1) ) 174 174 ! 175 175 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll … … 292 292 ENDIF 293 293 END_2D 294 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed)294 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed) 295 295 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 296 296 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 297 297 ENDIF 298 298 ! 299 ! TEMP: This change not necessary and working array can use ST_2D(nn_hls) if using XIOS (subdomain support)299 ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support) 300 300 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 301 301 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trazdf.F90
r13553 r13819 82 82 ! JMM avoid negative salinities near river outlet ! Ugly fix 83 83 ! JMM : restore negative salinities to small salinities: 84 WHERE( pts( ST_2D(0),:,jp_sal,Kaa) < 0._wp ) pts(ST_2D(0),:,jp_sal,Kaa) = 0.1_wp84 WHERE( pts(A2D(0),:,jp_sal,Kaa) < 0._wp ) pts(A2D(0),:,jp_sal,Kaa) = 0.1_wp 85 85 !!gm 86 86 … … 139 139 INTEGER :: ji, jj, jk, jn ! dummy loop indices 140 140 REAL(wp) :: zrhs, zzwi, zzws ! local scalars 141 REAL(wp), DIMENSION( ST_2D(nn_hls),jpk) :: zwi, zwt, zwd, zws141 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws 142 142 !!--------------------------------------------------------------------- 143 143 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90
r13553 r13819 41 41 CONTAINS 42 42 43 ! TODO: NOT TESTED- requires zps44 43 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 45 44 & prd, pgru, pgrv ) … … 112 111 INTEGER , INTENT(in ) :: kjpt ! number of tracers 113 112 INTEGER , INTENT(in ) :: ktta, ktgt, ktrd, ktgr 114 REAL(wp), DIMENSION( ST_2DT(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields115 REAL(wp), DIMENSION( ST_2DT(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts116 REAL(wp), DIMENSION( ST_2DT(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields117 REAL(wp), DIMENSION( ST_2DT(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)113 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields 114 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 115 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 116 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 118 117 ! 119 118 INTEGER :: ji, jj, jn ! Dummy loop indices 120 119 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 121 120 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars 122 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos123 REAL(wp), DIMENSION( ST_2D(nn_hls),kjpt) :: zti, ztj !121 REAL(wp), DIMENSION(A2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 122 REAL(wp), DIMENSION(A2D(nn_hls),kjpt) :: zti, ztj ! 124 123 !!---------------------------------------------------------------------- 125 124 ! … … 212 211 213 212 214 ! TODO: NOT TESTED- requires zps215 213 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 216 214 & prd, pgru, pgrv, pgrui, pgrvi ) … … 289 287 INTEGER , INTENT(in ) :: kjpt ! number of tracers 290 288 INTEGER , INTENT(in ) :: ktta, ktgt, ktgti, ktrd, ktgr, ktgri 291 REAL(wp), DIMENSION( ST_2DT(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields292 REAL(wp), DIMENSION( ST_2DT(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts293 REAL(wp), DIMENSION( ST_2DT(ktgti) ,KJPT), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)294 REAL(wp), DIMENSION( ST_2DT(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields295 REAL(wp), DIMENSION( ST_2DT(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)296 REAL(wp), DIMENSION( ST_2DT(ktgri) ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)289 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields 290 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 291 REAL(wp), DIMENSION(A2D_T(ktgti) ,KJPT), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 292 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 293 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 294 REAL(wp), DIMENSION(A2D_T(ktgri) ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 297 295 ! 298 296 INTEGER :: ji, jj, jn ! Dummy loop indices 299 297 INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points 300 298 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 301 REAL(wp), DIMENSION( ST_2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos302 REAL(wp), DIMENSION( ST_2D(nn_hls),kjpt) :: zti, ztj !299 REAL(wp), DIMENSION(A2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 300 REAL(wp), DIMENSION(A2D(nn_hls),kjpt) :: zti, ztj ! 303 301 !!---------------------------------------------------------------------- 304 302 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_hgr.F90
r13411 r13819 90 90 zcos_alpha = SQRT( 2._wp ) * 0.5_wp 91 91 ze1deg = ze1 / (ra * rad) 92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo , wp )93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo , wp )92 zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo - 2, wp ) 93 zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo - 2, wp ) 94 94 95 95 #if defined key_agrif -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/USR/usrdef_nam.F90
r13411 r13819 70 70 kk_cfg = nn_GYRE 71 71 ! 72 kpi = 30 * nn_GYRE !73 kpj = 20 * nn_GYRE 72 kpi = 30 * nn_GYRE + 2 ! 73 kpj = 20 * nn_GYRE + 2 74 74 #if defined key_agrif 75 75 IF( .NOT.Agrif_Root() ) THEN ! Global Domain size: add 1 land point on each side -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/do_loop_substitute.h90
r13539 r13819 60 60 61 61 #define DO_2D(B, T, L, R) DO jj = ntsj-(B), ntej+(T) ; DO ji = ntsi-(L), ntei+(R) 62 #define ST_1Di(H) ntsi-H:ntei+H63 #define ST_1Dj(H) ntsj-H:ntej+H64 #define ST_2D(H) ST_1Di(H),ST_1Dj(H)65 #define ST_1DTi(T) (ntsi-nn_hls-1)*T+1:66 #define ST_1DTj(T) (ntsj-nn_hls-1)*T+1:67 #define ST_2DT(T) ST_1DTi(T),ST_1DTj(T)62 #define A1Di(H) ntsi-H:ntei+H 63 #define A1Dj(H) ntsj-H:ntej+H 64 #define A2D(H) A1Di(H),A1Dj(H) 65 #define A1Di_T(T) (ntsi-nn_hls-1)*T+1: 66 #define A1Dj_T(T) (ntsj-nn_hls-1)*T+1: 67 #define A2D_T(T) A1Di_T(T),A1Dj_T(T) 68 68 #define JPK : 69 69 #define JPTS : -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/step.F90
r13521 r13819 265 265 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, ts, Nrhs ) ! internal damping trends 266 266 IF( ln_bdy ) CALL bdy_tra_dmp( kstp, Nbb, ts, Nrhs ) ! bdy damping trends 267 #if defined key_agrif268 ! TODO: TO BE TILED- I don't know what this does, or whether it can just be run for ntile == nijtile269 IF(.NOT. Agrif_Root()) &270 & CALL Agrif_Sponge_tra ! tracers sponge271 #endif272 267 END DO 273 268 274 ! TEMP: Loop over tile domains (seperate due to tra_adv workarounds for tiling) 269 #if defined key_agrif 270 IF(.NOT. Agrif_Root()) THEN 271 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 272 CALL Agrif_Sponge_tra ! tracers sponge 273 ENDIF 274 #endif 275 276 ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 275 277 DO jtile = 1, nijtile 276 278 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/tests/CANAL/MY_SRC/trazdf.F90
r13295 r13819 54 54 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 55 55 ! 56 INTEGER :: j k ! Dummy loop indices56 INTEGER :: ji, jj, jk ! Dummy loop indices 57 57 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 58 58 !!--------------------------------------------------------------------- … … 61 61 ! 62 62 IF( kt == nit000 ) THEN 63 IF(lwp)WRITE(numout,*) 64 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 65 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 63 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 64 IF(lwp)WRITE(numout,*) 65 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 66 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 67 ENDIF 66 68 ENDIF 67 69 ! … … 83 85 84 86 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 85 DO jk = 1, jpkm1 86 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 87 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk) 88 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 89 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk) 87 DO jk = 1, jpk 88 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) & 89 & - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 90 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 91 & - ztrdt(:,:,jk) 92 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) & 93 & - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 94 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 95 & - ztrds(:,:,jk) 90 96 END DO 91 97 !!gm this should be moved in trdtra.F90 and done on all trends … … 135 141 INTEGER :: ji, jj, jk, jn ! dummy loop indices 136 142 REAL(wp) :: zrhs, zzwi, zzws ! local scalars 137 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zwi, zwt, zwd, zws143 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws 138 144 !!--------------------------------------------------------------------- 139 145 ! … … 149 155 ! 150 156 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 151 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt(:,:,2:jpk) 152 ELSE ; zwt(:,:,2:jpk) = avs(:,:,2:jpk) 157 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 158 DO_3D( 1, 1, 1, 1, 2, jpk ) 159 zwt(ji,jj,jk) = avt(ji,jj,jk) 160 END_3D 161 ELSE 162 DO_3D( 1, 1, 1, 1, 2, jpk ) 163 zwt(ji,jj,jk) = avs(ji,jj,jk) 164 END_3D 153 165 ENDIF 154 166 zwt(:,:,1) = 0._wp -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/tests/ISOMIP+/MY_SRC/dtatsd.F90
r13742 r13819 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domain, ONLY : dom_tile 20 21 USE fldread ! read input fields 21 22 ! … … 163 164 INTEGER , INTENT(in ) :: kt ! ocean time-step 164 165 CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini 165 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data166 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 166 167 ! 167 168 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 168 169 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 170 INTEGER :: itile 169 171 REAL(wp):: zl, zi ! local scalars 170 172 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 171 173 !!---------------------------------------------------------------------- 172 174 ! 175 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 176 itile = ntile 177 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 178 179 SELECT CASE(cddta) 180 CASE('ini') 181 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 182 CASE('dmp') 183 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 184 CASE DEFAULT 185 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 186 END SELECT 187 188 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 189 ENDIF 190 ! 173 191 SELECT CASE(cddta) 174 CASE('ini') 175 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 176 ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:) ! NO mask 177 ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:) 192 CASE('ini') 193 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 194 ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk) ! NO mask 195 ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk) 196 END_3D 178 197 CASE('dmp') 179 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 180 ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:) ! NO mask 181 ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:) 198 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 199 ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk) ! NO mask 200 ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk) 201 END_3D 182 202 CASE DEFAULT 183 203 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') … … 186 206 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 207 ! 188 IF( kt == nit000 .AND. lwp )THEN 189 WRITE(numout,*) 190 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 208 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 209 IF( kt == nit000 .AND. lwp )THEN 210 WRITE(numout,*) 211 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 212 ENDIF 191 213 ENDIF 192 214 ! … … 220 242 ELSE !== z- or zps- coordinate ==! 221 243 ! 222 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 223 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 244 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 245 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 246 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 247 END_3D 224 248 ! 225 249 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/tests/ISOMIP+/MY_SRC/eosbn2.F90
r13742 r13819 39 39 !!---------------------------------------------------------------------- 40 40 USE dom_oce ! ocean space and time domain 41 USE domutl, ONLY : is_tile 41 42 USE phycst ! physical constants 42 43 USE stopar ! Stochastic T/S fluctuations … … 191 192 192 193 SUBROUTINE eos_insitu( pts, prd, pdep ) 194 !! 195 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 196 ! ! 2 : salinity [psu] 197 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 198 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 199 !! 200 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 201 END SUBROUTINE eos_insitu 202 203 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 193 204 !!---------------------------------------------------------------------- 194 205 !! *** ROUTINE eos_insitu *** … … 228 239 !! TEOS-10 Manual, 2010 229 240 !!---------------------------------------------------------------------- 230 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 241 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 242 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 231 243 ! ! 2 : salinity [psu] 232 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]233 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]244 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 245 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 234 246 ! 235 247 INTEGER :: ji, jj, jk ! dummy loop indices … … 312 324 IF( ln_timing ) CALL timing_stop('eos-insitu') 313 325 ! 314 END SUBROUTINE eos_insitu 326 END SUBROUTINE eos_insitu_t 315 327 316 328 317 329 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 330 !! 331 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 332 ! ! 2 : salinity [psu] 333 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 334 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 335 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 336 !! 337 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 338 END SUBROUTINE eos_insitu_pot 339 340 341 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 318 342 !!---------------------------------------------------------------------- 319 343 !! *** ROUTINE eos_insitu_pot *** … … 328 352 !! 329 353 !!---------------------------------------------------------------------- 330 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 354 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 355 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 331 356 ! ! 2 : salinity [psu] 332 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]333 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prhop ! potential density (surface referenced)334 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]357 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 358 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 359 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 335 360 ! 336 361 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 482 507 IF( ln_timing ) CALL timing_stop('eos-pot') 483 508 ! 484 END SUBROUTINE eos_insitu_pot 509 END SUBROUTINE eos_insitu_pot_t 485 510 486 511 487 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !! 514 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 515 ! ! 2 : salinity [psu] 516 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 517 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 518 !! 519 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 520 END SUBROUTINE eos_insitu_2d 521 522 523 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 488 524 !!---------------------------------------------------------------------- 489 525 !! *** ROUTINE eos_insitu_2d *** … … 496 532 !! 497 533 !!---------------------------------------------------------------------- 498 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 534 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 535 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 499 536 ! ! 2 : salinity [psu] 500 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pdep ! depth [m]501 REAL(wp), DIMENSION( jpi,jpj), INTENT( out) :: prd ! in situ density537 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 538 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 502 539 ! 503 540 INTEGER :: ji, jj, jk ! dummy loop indices … … 584 621 IF( ln_timing ) CALL timing_stop('eos2d') 585 622 ! 586 END SUBROUTINE eos_insitu_2d 623 END SUBROUTINE eos_insitu_2d_t 587 624 588 625 589 626 SUBROUTINE rab_3d( pts, pab, Kmm ) 627 !! 628 INTEGER , INTENT(in ) :: Kmm ! time level index 629 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 630 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 631 !! 632 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 633 END SUBROUTINE rab_3d 634 635 636 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 590 637 !!---------------------------------------------------------------------- 591 638 !! *** ROUTINE rab_3d *** … … 598 645 !!---------------------------------------------------------------------- 599 646 INTEGER , INTENT(in ) :: Kmm ! time level index 600 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 647 INTEGER , INTENT(in ) :: ktts, ktab 648 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 649 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 602 650 ! 603 651 INTEGER :: ji, jj, jk ! dummy loop indices … … 706 754 IF( ln_timing ) CALL timing_stop('rab_3d') 707 755 ! 708 END SUBROUTINE rab_3d 756 END SUBROUTINE rab_3d_t 709 757 710 758 711 759 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 760 !! 761 INTEGER , INTENT(in ) :: Kmm ! time level index 762 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 763 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 764 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 765 !! 766 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 767 END SUBROUTINE rab_2d 768 769 770 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 712 771 !!---------------------------------------------------------------------- 713 772 !! *** ROUTINE rab_2d *** … … 718 777 !!---------------------------------------------------------------------- 719 778 INTEGER , INTENT(in ) :: Kmm ! time level index 720 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 721 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 722 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 779 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 780 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 781 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 782 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 723 783 ! 724 784 INTEGER :: ji, jj, jk ! dummy loop indices … … 829 889 IF( ln_timing ) CALL timing_stop('rab_2d') 830 890 ! 831 END SUBROUTINE rab_2d 891 END SUBROUTINE rab_2d_t 832 892 833 893 … … 942 1002 943 1003 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 1004 !! 1005 INTEGER , INTENT(in ) :: Kmm ! time level index 1006 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 1007 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1008 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 1009 !! 1010 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 1011 END SUBROUTINE bn2 1012 1013 1014 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 944 1015 !!---------------------------------------------------------------------- 945 1016 !! *** ROUTINE bn2 *** … … 956 1027 !!---------------------------------------------------------------------- 957 1028 INTEGER , INTENT(in ) :: Kmm ! time level index 1029 INTEGER , INTENT(in ) :: ktab, ktn2 958 1030 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 959 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]960 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]1031 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1032 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 961 1033 ! 962 1034 INTEGER :: ji, jj, jk ! dummy loop indices … … 982 1054 IF( ln_timing ) CALL timing_stop('bn2') 983 1055 ! 984 END SUBROUTINE bn2 1056 END SUBROUTINE bn2_t 985 1057 986 1058 … … 1043 1115 1044 1116 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1117 !! 1118 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1119 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1120 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1121 !! 1122 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1123 END SUBROUTINE eos_fzp_2d 1124 1125 1126 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 1045 1127 !!---------------------------------------------------------------------- 1046 1128 !! *** ROUTINE eos_fzp *** … … 1054 1136 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1055 1137 !!---------------------------------------------------------------------- 1138 INTEGER , INTENT(in ) :: kttf 1056 1139 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1057 1140 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1058 REAL(wp), DIMENSION( jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius]1141 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1059 1142 ! 1060 1143 INTEGER :: ji, jj ! dummy loop indices … … 1089 1172 END SELECT 1090 1173 ! 1091 END SUBROUTINE eos_fzp_2d 1174 END SUBROUTINE eos_fzp_2d_t 1092 1175 1093 1176 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/tests/ISOMIP+/MY_SRC/tradmp.F90
r13295 r13819 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices 97 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts) :: zts_dta97 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta 98 98 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 99 99 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.