Changeset 13518 for NEMO/branches
- Timestamp:
- 2020-09-24T20:49:07+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 9 edited
-
ASM/asminc.F90 (modified) (14 diffs)
-
BDY/bdytra.F90 (modified) (2 diffs)
-
DOM/dtatsd.F90 (modified) (4 diffs)
-
TRA/trabbc.F90 (modified) (3 diffs)
-
TRA/trabbl.F90 (modified) (8 diffs)
-
TRA/tradmp.F90 (modified) (4 diffs)
-
TRA/traisf.F90 (modified) (8 diffs)
-
TRA/traqsr.F90 (modified) (7 diffs)
-
TRA/trasbc.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ASM/asminc.F90
r13295 r13518 520 520 INTEGER :: it 521 521 REAL(wp) :: zincwgt ! IAU weight for current time step 522 REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values522 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 523 523 !!---------------------------------------------------------------------- 524 524 ! 525 525 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 526 ! used to prevent the applied increments taking the temperature below the local freezing point 527 DO jk = 1, jpkm1 528 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 529 END DO 527 ! TODO: NOT TESTED- logical is forced to False 528 IF( ln_temnofreeze ) THEN 529 DO jk = 1, jpkm1 530 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 531 END DO 532 ENDIF 530 533 ! 531 534 ! !-------------------------------------- … … 538 541 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 542 ! 540 IF(lwp) THEN 541 WRITE(numout,*) 542 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 543 WRITE(numout,*) '~~~~~~~~~~~~' 543 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 544 IF(lwp) THEN 545 WRITE(numout,*) 546 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 547 WRITE(numout,*) '~~~~~~~~~~~~' 548 ENDIF 544 549 ENDIF 545 550 ! 546 551 ! Update the tracer tendencies 552 ! TODO: NOT TESTED- logical is forced to False 547 553 DO jk = 1, jpkm1 548 554 IF (ln_temnofreeze) THEN 549 555 ! Do not apply negative increments if the temperature will fall below freezing 550 WHERE(t_bkginc( :,:,jk) > 0.0_wp .OR. &551 & pts( :,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )552 pts( :,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt556 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) * zincwgt 553 559 END WHERE 554 560 ELSE 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 561 DO_2D( 0, 0, 0, 0 ) 562 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 563 END_2D 556 564 ENDIF 557 565 IF (ln_salfix) THEN 558 566 ! Do not apply negative increments if the salinity will fall below a specified 559 567 ! minimum value salfixmin 560 WHERE(s_bkginc( :,:,jk) > 0.0_wp .OR. &561 & pts( :,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )562 pts( :,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt568 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) * zincwgt 563 571 END WHERE 564 572 ELSE 565 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 573 DO_2D( 0, 0, 0, 0 ) 574 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 575 END_2D 566 576 ENDIF 567 577 END DO … … 569 579 ENDIF 570 580 ! 571 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 572 DEALLOCATE( t_bkginc ) 573 DEALLOCATE( s_bkginc ) 581 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 582 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 583 DEALLOCATE( t_bkginc ) 584 DEALLOCATE( s_bkginc ) 585 ENDIF 574 586 ENDIF 575 587 ! !-------------------------------------- … … 582 594 ! 583 595 ! Initialize the now fields with the background + increment 596 ! TODO: NOT TESTED- logical is forced to False 584 597 IF (ln_temnofreeze) THEN 585 598 ! Do not apply negative increments if the temperature will fall below freezing 586 WHERE( t_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )587 pts( :,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)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),:) 588 601 END WHERE 589 602 ELSE 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 603 DO_3D( 0, 0, 0, 0, 1, jpk ) 604 pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 605 END_3D 591 606 ENDIF 592 607 IF (ln_salfix) THEN 593 608 ! Do not apply negative increments if the salinity will fall below a specified 594 609 ! minimum value salfixmin 595 WHERE( s_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )596 pts( :,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)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),:) 597 612 END WHERE 598 613 ELSE 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 ENDIF 601 602 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 614 DO_3D( 0, 0, 0, 0, 1, jpk ) 615 pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 616 END_3D 617 ENDIF 618 619 DO_3D( 0, 0, 0, 0, 1, jpk ) 620 pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm) ! Update before fields 621 END_3D 603 622 604 623 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 607 626 !!gm 608 627 609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 610 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 613 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 614 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 615 616 DEALLOCATE( t_bkginc ) 617 DEALLOCATE( s_bkginc ) 618 DEALLOCATE( t_bkg ) 619 DEALLOCATE( s_bkg ) 628 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 629 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 630 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 631 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 632 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 633 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 634 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 635 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 636 ENDIF 637 638 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 639 DEALLOCATE( t_bkginc ) 640 DEALLOCATE( s_bkginc ) 641 DEALLOCATE( t_bkg ) 642 DEALLOCATE( s_bkg ) 643 ENDIF 644 ! 620 645 ENDIF 621 646 ! 622 647 ENDIF 648 ! TODO: NOT TESTED- logical is forced to False 623 649 ! Perhaps the following call should be in step 624 650 IF ( ln_seaiceinc ) CALL seaice_asm_inc ( kt ) ! apply sea ice concentration increment … … 829 855 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 830 856 ! 857 INTEGER :: ji, jj 831 858 INTEGER :: it 832 859 REAL(wp) :: zincwgt ! IAU weight for current time step 833 860 #if defined key_si3 834 REAL(wp), DIMENSION( jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc861 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc 835 862 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres 836 863 #endif … … 847 874 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 848 875 ! 849 IF(lwp) THEN 850 WRITE(numout,*) 851 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 852 WRITE(numout,*) '~~~~~~~~~~~~' 876 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 877 IF(lwp) THEN 878 WRITE(numout,*) 879 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 880 WRITE(numout,*) '~~~~~~~~~~~~' 881 ENDIF 853 882 ENDIF 854 883 ! … … 856 885 ! 857 886 #if defined key_si3 858 zofrld (:,:) = 1._wp - at_i(:,:) 859 zohicif(:,:) = hm_i(:,:) 860 ! 861 at_i (:,:) = 1. - MIN( MAX( 1.-at_i (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 862 at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 863 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 864 ! 865 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 887 DO_2D( 0, 0, 0, 0 ) 888 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 889 zohicif(ji,jj) = hm_i(ji,jj) 890 ! 891 at_i (ji,jj) = 1. - MIN( MAX( 1.-at_i (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 892 at_i_b(ji,jj) = 1. - MIN( MAX( 1.-at_i_b(ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 893 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 894 ! 895 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 896 END_2D 866 897 ! 867 898 ! Nudge sea ice depth to bring it up to a required minimum depth 868 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )869 zhicifinc(:,:) = (zhicifmin - hm_i( :,:)) * zincwgt899 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 900 zhicifinc(:,:) = (zhicifmin - hm_i(ST_2D(0))) * zincwgt 870 901 ELSEWHERE 871 902 zhicifinc(:,:) = 0.0_wp … … 873 904 ! 874 905 ! nudge ice depth 875 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 906 DO_2D( 0, 0, 0, 0 ) 907 hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 908 END_2D 876 909 ! 877 910 ! seaice salinity balancing (to add) … … 880 913 #if defined key_cice && defined key_asminc 881 914 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 882 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 883 #endif 884 ! 885 IF ( kt == nitiaufin_r ) THEN 886 DEALLOCATE( seaice_bkginc ) 915 DO_2D( 0, 0, 0, 0 ) 916 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 917 END_2D 918 #endif 919 ! 920 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 921 IF ( kt == nitiaufin_r ) THEN 922 DEALLOCATE( seaice_bkginc ) 923 ENDIF 887 924 ENDIF 888 925 ! … … 890 927 ! 891 928 #if defined key_cice && defined key_asminc 892 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 929 DO_2D( 0, 0, 0, 0 ) 930 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 931 END_2D 893 932 #endif 894 933 ! … … 905 944 ! 906 945 #if defined key_si3 907 zofrld (:,:) = 1._wp - at_i(:,:) 908 zohicif(:,:) = hm_i(:,:) 909 ! 910 ! Initialize the now fields the background + increment 911 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 912 at_i_b(:,:) = at_i(:,:) 913 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 914 ! 915 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 946 DO_2D( 0, 0, 0, 0 ) 947 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 948 zohicif(ji,jj) = hm_i(ji,jj) 949 ! 950 ! Initialize the now fields the background + increment 951 at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 952 at_i_b(ji,jj) = at_i(ji,jj) 953 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 954 ! 955 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 956 END_2D 916 957 ! 917 958 ! Nudge sea ice depth to bring it up to a required minimum depth 918 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )919 zhicifinc(:,:) = zhicifmin - hm_i( :,:)959 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 960 zhicifinc(:,:) = zhicifmin - hm_i(ST_2D(0)) 920 961 ELSEWHERE 921 962 zhicifinc(:,:) = 0.0_wp … … 923 964 ! 924 965 ! nudge ice depth 925 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 966 DO_2D( 0, 0, 0, 0 ) 967 hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 968 END_2D 926 969 ! 927 970 ! seaice salinity balancing (to add) … … 930 973 #if defined key_cice && defined key_asminc 931 974 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 932 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 933 #endif 934 IF ( .NOT. PRESENT(kindic) ) THEN 935 DEALLOCATE( seaice_bkginc ) 936 END IF 975 DO_2D( 0, 0, 0, 0 ) 976 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 977 END_2D 978 #endif 979 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 980 IF ( .NOT. PRESENT(kindic) ) THEN 981 DEALLOCATE( seaice_bkginc ) 982 END IF 983 ENDIF 937 984 ! 938 985 ELSE 939 986 ! 940 987 #if defined key_cice && defined key_asminc 941 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 988 DO_2D( 0, 0, 0, 0 ) 989 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 990 END_2D 942 991 #endif 943 992 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/BDY/bdytra.F90
r13226 r13518 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain variables 15 USE dom_oce ! ocean space and time domain variables 16 16 USE bdy_oce ! ocean open boundary conditions 17 17 USE bdylib ! for orlanski library routines … … 157 157 INTEGER :: ib_bdy ! Loop index 158 158 !!---------------------------------------------------------------------- 159 ! TODO: TO BE TILED 160 ! TODO: NOT TESTED- requires bdy 161 ! 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 IF( ntile /= 0 .AND. ntile /= 1 ) RETURN ! Do only for the full domain 159 163 ! 160 164 IF( ln_timing ) CALL timing_start('bdy_tra_dmp') -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/dtatsd.F90
r13295 r13518 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 ! … … 135 136 !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt 136 137 !!---------------------------------------------------------------------- 137 INTEGER 138 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data138 INTEGER , INTENT(in ) :: kt ! ocean time-step 139 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 139 140 ! 140 141 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies … … 144 145 !!---------------------------------------------------------------------- 145 146 ! 146 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 147 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 148 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 149 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 147 150 ! 148 151 ! 149 152 !!gm This should be removed from the code ===>>>> T & S files has to be changed 150 ! 151 ! !== ORCA_R2 configuration and T & S damping ==! 152 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 ! 155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 DO jj = mj0(ij0), mj1(ij1) 158 DO ji = mi0(ii0), mi1(ii1) 159 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 161 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 162 ! 163 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 166 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 153 ! 154 ! !== ORCA_R2 configuration and T & S damping ==! 155 ! TODO: NOT TESTED- requires orca2 156 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 157 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 158 ! 159 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 160 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 161 DO jj = mj0(ij0), mj1(ij1) 162 DO ji = mi0(ii0), mi1(ii1) 163 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 164 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 165 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 166 ! 167 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 168 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 169 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 170 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 171 END DO 167 172 END DO 168 END DO 169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 173 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 174 ENDIF 175 ENDIF 173 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 174 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 175 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 176 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 177 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 178 ENDIF 179 ENDIF 176 180 !!gm end 177 ! 178 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 179 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 181 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) ! Revert to tile domain 182 ENDIF 183 ! 184 DO_3D( 0, 0, 0, 0, 1, jpk ) 185 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 186 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 187 END_3D 180 188 ! 181 189 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 182 190 ! 183 IF( kt == nit000 .AND. lwp )THEN 184 WRITE(numout,*) 185 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 191 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 192 IF( kt == nit000 .AND. lwp )THEN 193 WRITE(numout,*) 194 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 195 ENDIF 186 196 ENDIF 187 197 ! … … 215 225 ELSE !== z- or zps- coordinate ==! 216 226 ! 217 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 218 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 219 ! 227 DO_3D( 0, 0, 0, 0, 1, jpk ) 228 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 229 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 230 END_3D 231 ! 232 ! TODO: NOT TESTED- requires zps 220 233 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 221 234 DO_2D( 1, 1, 1, 1 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbc.F90
r13295 r13518 17 17 USE oce ! ocean variables 18 18 USE dom_oce ! domain: ocean 19 ! TEMP: This change not necessary after trd_tra is tiled 20 USE domain, ONLY : dom_tile 19 21 USE phycst ! physical constants 20 22 USE trd_oce ! trends: ocean variables … … 80 82 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 81 83 ! 82 INTEGER :: ji, jj ! dummy loop indices 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt ! 3D workspace 84 INTEGER :: ji, jj, jk ! dummy loop indices 85 ! TEMP: This change not necessary after trd_tra is tiled 86 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt ! 3D workspace 84 87 !!---------------------------------------------------------------------- 85 88 ! 86 89 IF( ln_timing ) CALL timing_start('tra_bbc') 87 90 ! 88 IF( l_trdtra ) THEN ! Save the input temperature trend 89 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 90 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 91 IF( l_trdtra ) THEN ! Save the input temperature trend 92 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 93 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 94 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 95 ENDIF 96 97 DO_3D( 0, 0, 0, 0, 1, jpk ) 98 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 99 END_3D 91 100 ENDIF 92 101 ! ! Add the geothermal trend on temperature … … 96 105 END_2D 97 106 ! 98 CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1.0_wp ) 99 ! 100 IF( l_trdtra ) THEN ! Send the trend for diagnostics 101 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 102 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 103 DEALLOCATE( ztrdt ) 104 ENDIF 105 ! 106 CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 107 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 107 ! TEMP: These changes not necessary after trd_tra is tiled, lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes) 108 IF( l_trdtra ) THEN 109 DO_3D( 0, 0, 0, 0, 1, jpk ) 110 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 111 END_3D 112 ENDIF 113 114 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 115 ! 116 IF( l_trdtra ) THEN ! Send the trend for diagnostics 117 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 118 119 ! TODO: TO BE TILED- trd_tra 120 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 121 DEALLOCATE( ztrdt ) 122 123 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 124 ENDIF 125 ! 126 CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 127 ENDIF 128 129 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, & 130 & clinfo3='tra-ta' ) 108 131 ! 109 132 IF( ln_timing ) CALL timing_stop('tra_bbc') -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90
r13295 r13518 26 26 USE oce ! ocean dynamics and active tracers 27 27 USE dom_oce ! ocean space and time domain 28 ! TEMP: This change not necessary after trd_tra is tiled 29 USE domain, ONLY : dom_tile 28 30 USE phycst ! physical constant 29 31 USE eosbn2 ! equation of state … … 106 108 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 107 109 ! 108 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 110 INTEGER :: ji, jj, jk ! Dummy loop indices 111 ! TEMP: This change not necessary after trd_tra is tiled 112 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt, ztrds 109 113 !!---------------------------------------------------------------------- 110 114 ! … … 112 116 ! 113 117 IF( l_trdtra ) THEN !* Save the T-S input trends 114 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 115 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 116 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 118 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 119 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 120 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 121 ENDIF 122 123 DO_3D( 0, 0, 0, 0, 1, jpk ) 124 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 125 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 126 END_3D 117 127 ENDIF 118 128 … … 125 135 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 126 136 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 127 ! lateral boundary conditions ; just need for outputs 128 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 137 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 138 ! lateral boundary conditions ; just need for outputs 139 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 140 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 141 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 142 ENDIF 131 143 ! 132 144 ENDIF … … 136 148 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 137 149 IF(sn_cfctl%l_prtctl) & 138 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, 150 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 139 151 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 ! lateral boundary conditions ; just need for outputs 141 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 142 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 143 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 144 ! 145 ENDIF 146 152 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 153 ! lateral boundary conditions ; just need for outputs 154 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 155 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 156 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 157 ENDIF 158 ! 159 ENDIF 160 161 ! TEMP: These changes not necessary after trd_tra is tiled 147 162 IF( l_trdtra ) THEN ! send the trends for further diagnostics 148 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 149 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 150 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 152 DEALLOCATE( ztrdt, ztrds ) 163 DO_3D( 0, 0, 0, 0, 1, jpk ) 164 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 165 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 166 END_3D 167 168 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 169 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 170 171 ! TODO: TO BE TILED- trd_tra 172 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 173 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 174 DEALLOCATE( ztrdt, ztrds ) 175 176 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 177 ENDIF 153 178 ENDIF 154 179 ! … … 187 212 INTEGER :: ik ! local integers 188 213 REAL(wp) :: zbtr ! local scalars 189 REAL(wp), DIMENSION( jpi,jpj) :: zptb ! workspace214 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zptb ! workspace 190 215 !!---------------------------------------------------------------------- 191 216 ! … … 242 267 DO jn = 1, kjpt ! tracer loop 243 268 ! ! =========== 244 DO jj = 1, jpjm1 245 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 246 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 247 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 248 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 249 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 250 zu_bbl = ABS( utr_bbl(ji,jj) ) 251 ! 252 ! ! up -slope T-point (shelf bottom point) 253 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 254 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 255 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 256 ! 257 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 258 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 259 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 260 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 261 END DO 262 ! 263 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 264 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 265 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 266 ENDIF 267 ! 268 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 269 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 270 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 271 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 272 zv_bbl = ABS( vtr_bbl(ji,jj) ) 273 ! 274 ! up -slope T-point (shelf bottom point) 275 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 276 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 277 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 278 ! 279 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 280 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 281 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 282 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 283 END DO 284 ! ! down-slope T-point (deep bottom point) 285 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 286 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 287 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 288 ENDIF 289 END DO 269 DO_2D( 1, 0, 1, 0 ) ! CAUTION start from i=1 to update i=2 when cyclic east-west 270 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 271 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 272 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 273 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 274 zu_bbl = ABS( utr_bbl(ji,jj) ) 275 ! 276 ! ! up -slope T-point (shelf bottom point) 277 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 278 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 279 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 280 ! 281 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 282 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 283 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 284 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 285 END DO 286 ! 287 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 288 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 289 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 290 ENDIF 290 291 ! 291 END DO 292 ! ! =========== 293 END DO ! end tracer 294 ! ! =========== 292 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 293 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 294 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 295 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 296 zv_bbl = ABS( vtr_bbl(ji,jj) ) 297 ! 298 ! up -slope T-point (shelf bottom point) 299 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 300 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 301 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 302 ! 303 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 304 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 305 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 306 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 307 END DO 308 ! ! down-slope T-point (deep bottom point) 309 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 310 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 311 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 312 ENDIF 313 END_2D 314 ! ! =========== 315 END DO ! end tracer 316 ! ! =========== 295 317 END SUBROUTINE tra_bbl_adv 296 318 … … 333 355 REAL(wp) :: za, zb, zgdrho ! local scalars 334 356 REAL(wp) :: zsign, zsigna, zgbbl ! - - 335 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts, zab ! 3D workspace 336 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, zdep ! 2D workspace 337 !!---------------------------------------------------------------------- 338 ! 339 IF( kt == kit000 ) THEN 340 IF(lwp) WRITE(numout,*) 341 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 342 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 357 REAL(wp), DIMENSION(ST_2D(nn_hls),jpts) :: zts, zab ! 3D workspace 358 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace 359 !!---------------------------------------------------------------------- 360 ! 361 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 362 IF( kt == kit000 ) THEN 363 IF(lwp) WRITE(numout,*) 364 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 365 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 366 ENDIF 343 367 ENDIF 344 368 ! !* bottom variables (T, S, alpha, beta, depth, velocity) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tradmp.F90
r13295 r13518 24 24 USE oce ! ocean: variables 25 25 USE dom_oce ! ocean: domain variables 26 ! TEMP: This change not necessary after trd_tra is tiled 27 USE domain, ONLY : dom_tile 26 28 USE c1d ! 1D vertical configuration 27 29 USE trd_oce ! trends: ocean variables … … 95 97 ! 96 98 INTEGER :: ji, jj, jk, jn ! dummy loop indices 97 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts_dta 98 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 99 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts) :: zts_dta 100 ! TEMP: This change not necessary after trd_tra is tiled 101 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: ztrdts 99 102 !!---------------------------------------------------------------------- 100 103 ! … … 102 105 ! 103 106 IF( l_trdtra ) THEN !* Save ta and sa trends 104 ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 105 ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 107 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 108 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 109 ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 110 ENDIF 111 112 DO_3D( 0, 0, 0, 0, 1, jpk ) 113 ztrdts(ji,jj,jk,:) = pts(ji,jj,jk,:,Krhs) 114 END_3D 106 115 ENDIF 107 116 ! !== input T-S data at kt ==! … … 140 149 END SELECT 141 150 ! 151 ! TEMP: These changes not necessary after trd_tra is tiled 142 152 IF( l_trdtra ) THEN ! trend diagnostic 143 ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 144 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 145 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 146 DEALLOCATE( ztrdts ) 153 DO_3D( 0, 0, 0, 0, 1, jpk ) 154 ztrdts(ji,jj,jk,:) = pts(ji,jj,jk,:,Krhs) - ztrdts(ji,jj,jk,:) 155 END_3D 156 157 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 158 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 159 160 ! TODO: TO BE TILED- trd_tra 161 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 162 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 163 DEALLOCATE( ztrdts ) 164 165 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 166 ENDIF 147 167 ENDIF 148 168 ! ! Control print -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traisf.F90
r13295 r13518 11 11 !!---------------------------------------------------------------------- 12 12 USE isf_oce ! Ice shelf variables 13 USE par_oce , ONLY : nijtile, ntile, ntsi, ntei, ntsj, ntej 13 14 USE dom_oce ! ocean space domain variables 14 15 USE isfutils, ONLY : debug ! debug option … … 31 32 CONTAINS 32 33 34 ! TODO: NOT TESTED- requires isf 33 35 SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs ) 34 36 !!---------------------------------------------------------------------- … … 46 48 IF( ln_timing ) CALL timing_start('tra_isf') 47 49 ! 48 IF( kt == nit000 ) THEN 49 IF(lwp) WRITE(numout,*) 50 IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes' 51 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 50 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 51 IF( kt == nit000 ) THEN 52 IF(lwp) WRITE(numout,*) 53 IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes' 54 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 55 ENDIF 52 56 ENDIF 53 57 ! … … 76 80 ! 77 81 IF ( ln_isfdebug ) THEN 78 CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 79 CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 82 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 83 CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 84 CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 85 ENDIF 80 86 END IF 81 87 ! … … 84 90 END SUBROUTINE tra_isf 85 91 ! 92 ! TODO: NOT TESTED- requires isf 86 93 SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts) 87 94 !!---------------------------------------------------------------------- … … 101 108 INTEGER :: ji,jj,jk ! loop index 102 109 INTEGER :: ikt, ikb ! top and bottom level of the tbl 103 REAL(wp), DIMENSION( jpi,jpj):: ztc ! total ice shelf tracer trend110 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: ztc ! total ice shelf tracer trend 104 111 !!---------------------------------------------------------------------- 105 112 ! 106 113 ! compute 2d total trend due to isf 107 ztc(:,:) = 0.5_wp * ( ptsc(:,:,jp_tem) + ptsc_b(:,:,jp_tem) ) / phtbl(:,:) 114 DO_2D( 1, 1, 1, 1 ) 115 ztc(ji,jj) = 0.5_wp * ( ptsc(ji,jj,jp_tem) + ptsc_b(ji,jj,jp_tem) ) / phtbl(ji,jj) 116 END_2D 108 117 ! 109 118 ! update pts(:,:,:,:,Krhs) … … 125 134 END SUBROUTINE tra_isf_mlt 126 135 ! 136 ! TODO: NOT TESTED- requires isf 127 137 SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa ) 128 138 !!---------------------------------------------------------------------- … … 137 147 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: ptsc 138 148 !!---------------------------------------------------------------------- 139 INTEGER :: j k149 INTEGER :: ji, jj, jk 140 150 !!---------------------------------------------------------------------- 141 151 ! 142 DO jk = 1,jpk 143 ptsa(:,:,jk,jp_tem) = & 144 & ptsa(:,:,jk,jp_tem) + ptsc(:,:,jk,jp_tem) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 145 ptsa(:,:,jk,jp_sal) = & 146 & ptsa(:,:,jk,jp_sal) + ptsc(:,:,jk,jp_sal) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 147 END DO 152 DO_3D( 0, 0, 0, 0, 1, jpk ) 153 ptsa(ji,jj,jk,jp_tem) = ptsa(ji,jj,jk,jp_tem) + ptsc(ji,jj,jk,jp_tem) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 154 ptsa(ji,jj,jk,jp_sal) = ptsa(ji,jj,jk,jp_sal) + ptsc(ji,jj,jk,jp_sal) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 155 END_3D 148 156 ! 149 157 END SUBROUTINE tra_isf_cpl -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90
r13333 r13518 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain 24 USE domain, ONLY : dom_tile 24 25 USE sbc_oce ! surface boundary condition: ocean 25 26 USE trc_oce ! share SMS/Ocean variables … … 114 115 REAL(wp) :: zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze 115 116 REAL(wp) :: zlogc, zlogze, zlogCtot, zlogCze 117 ! TEMP: These changes not necessary after trd_tra is tiled 118 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt 116 119 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ze0, ze1, ze2, ze3 117 120 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d … … 120 123 IF( ln_timing ) CALL timing_start('tra_qsr') 121 124 ! 122 IF( kt == nit000 ) THEN 123 IF(lwp) WRITE(numout,*) 124 IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 125 IF(lwp) WRITE(numout,*) '~~~~~~~' 125 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 126 IF( kt == nit000 ) THEN 127 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 129 IF(lwp) WRITE(numout,*) '~~~~~~~' 130 ENDIF 126 131 ENDIF 127 132 ! 128 133 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 130 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 134 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 135 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 136 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 137 ENDIF 138 139 DO_3D( 0, 0, 0, 0, 1, jpk ) 140 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 141 END_3D 131 142 ENDIF 132 143 ! … … 136 147 IF( kt == nit000 ) THEN !== 1st time step ==! 137 148 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN ! read in restart 138 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file'139 149 z1_2 = 0.5_wp 140 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios ) ! before heat content trend due to Qsr flux 150 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 151 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 152 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios ) ! before heat content trend due to Qsr flux 153 ENDIF 141 154 ELSE ! No restart or restart not found: Euler forward time stepping 142 155 z1_2 = 1._wp 143 qsr_hc_b(:,:,:) = 0._wp 156 DO_3D( 0, 0, 0, 0, 1, jpk ) 157 qsr_hc_b(ji,jj,jk) = 0._wp 158 END_3D 144 159 ENDIF 145 160 ELSE !== Swap of qsr heat content ==! 146 161 z1_2 = 0.5_wp 147 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 162 DO_3D( 0, 0, 0, 0, 1, jpk ) 163 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 164 END_3D 148 165 ENDIF 149 166 ! … … 154 171 CASE( np_BIO ) !== bio-model fluxes ==! 155 172 ! 156 DO jk = 1, nksr157 qsr_hc( :,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )158 END DO173 DO_3D( 0, 0, 0, 0, 1, nksr ) 174 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 175 END_3D 159 176 ! 160 177 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 161 178 ! 162 ALLOCATE( ze0 ( jpi,jpj) , ze1 (jpi,jpj) , &163 & ze2 ( jpi,jpj) , ze3 (jpi,jpj) , &164 & ztmp3d( jpi,jpj,nksr + 1) )179 ALLOCATE( ze0 (ST_2D(nn_hls)) , ze1 (ST_2D(nn_hls)) , & 180 & ze2 (ST_2D(nn_hls)) , ze3 (ST_2D(nn_hls)) , & 181 & ztmp3d(ST_2D(nn_hls),nksr + 1) ) 165 182 ! 166 183 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 184 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 185 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 186 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 187 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) ! Revert to tile domain 188 ENDIF 168 189 ! 169 190 ! Separation in R-G-B depending on the surface Chl … … 215 236 ! Convert chlorophyll value to attenuation coefficient look-up table index 216 237 zlui = 41 + 20.*LOG10(zchl) + 1.e-15 217 DO jk = 1, nksr + 1218 ztmp3d( :,:,jk) = zlui219 END DO238 DO_3D( 1, 1, 1, 1, 1, nksr + 1 ) 239 ztmp3d(ji,jj,jk) = zlui 240 END_3D 220 241 ENDIF 221 242 ! … … 277 298 ENDIF 278 299 END_2D 279 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 280 ! 281 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 282 ALLOCATE( zetot(jpi,jpj,jpk) ) 283 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 284 DO jk = nksr, 1, -1 285 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 286 END DO 287 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 288 DEALLOCATE( zetot ) 289 ENDIF 290 ! 291 IF( lrst_oce ) THEN ! write in the ocean restart file 292 IF( lwxios ) CALL iom_swap( cwxios_context ) 293 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc , ldxios = lwxios ) 294 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 295 IF( lwxios ) CALL iom_swap( cxios_context ) 296 ENDIF 297 ! 300 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed) 301 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 302 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 303 ENDIF 304 ! 305 ! TEMP: This change not necessary and working array can use ST_2D(nn_hls) if using XIOS (subdomain support) 306 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 307 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 308 ALLOCATE( zetot(jpi,jpj,jpk) ) 309 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 310 DO jk = nksr, 1, -1 311 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 312 END DO 313 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 314 DEALLOCATE( zetot ) 315 ENDIF 316 ENDIF 317 ! 318 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 319 IF( lrst_oce ) THEN ! write in the ocean restart file 320 IF( lwxios ) CALL iom_swap( cwxios_context ) 321 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc , ldxios = lwxios ) 322 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 323 IF( lwxios ) CALL iom_swap( cxios_context ) 324 ENDIF 325 ENDIF 326 ! 327 ! TEMP: These changes not necessary after trd_tra is tiled 298 328 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 299 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 300 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 301 DEALLOCATE( ztrdt ) 329 DO_3D( 0, 0, 0, 0, 1, jpk ) 330 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 331 END_3D 332 333 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 334 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 335 336 ! TODO: TO BE TILED- trd_tra 337 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 338 DEALLOCATE( ztrdt ) 339 340 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 341 ENDIF 302 342 ENDIF 303 343 ! ! print mean trends (used for debugging) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trasbc.F90
r13295 r13518 19 19 USE sbc_oce ! surface boundary condition: ocean 20 20 USE dom_oce ! ocean space domain variables 21 ! TEMP: This change not necessary after trd_tra is tiled 22 USE domain, ONLY : dom_tile 21 23 USE phycst ! physical constant 22 24 USE eosbn2 ! Equation Of State … … 79 81 INTEGER :: ikt, ikb ! local integers 80 82 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 83 ! TEMP: This change not necessary after trd_tra is tiled 84 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt, ztrds 82 85 !!---------------------------------------------------------------------- 83 86 ! 84 87 IF( ln_timing ) CALL timing_start('tra_sbc') 85 88 ! 86 IF( kt == nit000 ) THEN 87 IF(lwp) WRITE(numout,*) 88 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 89 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 89 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 90 IF( kt == nit000 ) THEN 91 IF(lwp) WRITE(numout,*) 92 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 93 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 94 ENDIF 90 95 ENDIF 91 96 ! 92 97 IF( l_trdtra ) THEN !* Save ta and sa trends 93 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 94 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 95 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 98 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 99 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 100 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 101 ENDIF 102 103 DO_3D( 0, 0, 0, 0, 1, jpk ) 104 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 105 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 106 END_3D 96 107 ENDIF 97 108 ! 98 109 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 99 110 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 100 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 101 qsr(:,:) = 0._wp ! qsr set to zero 111 DO_2D( 0, 0, 0, 0 ) 112 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 113 qsr(ji,jj) = 0._wp ! qsr set to zero 114 END_2D 102 115 ENDIF 103 116 … … 109 122 IF( ln_rstart .AND. & ! Restart: read in restart file 110 123 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 111 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file'112 124 zfact = 0.5_wp 113 sbc_tsc(:,:,:) = 0._wp 114 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend 115 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend 125 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 126 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 127 sbc_tsc(:,:,:) = 0._wp 128 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend 129 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend 130 ENDIF 116 131 ELSE ! No restart or restart not found: Euler forward time stepping 117 132 zfact = 1._wp 118 sbc_tsc(:,:,:) = 0._wp 119 sbc_tsc_b(:,:,:) = 0._wp 133 DO_2D( 0, 0, 0, 0 ) 134 sbc_tsc(ji,jj,:) = 0._wp 135 sbc_tsc_b(ji,jj,:) = 0._wp 136 END_2D 120 137 ENDIF 121 138 ELSE !* other time-steps: swap of forcing fields 122 139 zfact = 0.5_wp 123 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 140 DO_2D( 0, 0, 0, 0 ) 141 sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 142 END_2D 124 143 ENDIF 125 144 ! !== Now sbc tracer content fields ==! 126 DO_2D( 0, 1, 0, 0 )145 DO_2D( 0, 0, 0, 0 ) 127 146 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 147 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 148 END_2D 130 149 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( 0, 1, 0, 0 )150 DO_2D( 0, 0, 0, 0 ) 132 151 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 152 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 134 153 END_2D 135 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 136 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 154 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 155 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 156 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 157 ENDIF 137 158 ENDIF 138 159 ! 139 160 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D( 0, 1, 0, 0 ) 141 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 & / e3t(ji,jj,1,Kmm) 161 DO_2D( 0, 0, 0, 0 ) 162 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm) 143 163 END_2D 144 164 END DO 145 165 ! 146 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 147 IF( lwxios ) CALL iom_swap( cwxios_context ) 148 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios ) 149 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios ) 150 IF( lwxios ) CALL iom_swap( cxios_context ) 166 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 167 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 168 IF( lwxios ) CALL iom_swap( cwxios_context ) 169 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios ) 170 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios ) 171 IF( lwxios ) CALL iom_swap( cxios_context ) 172 ENDIF 151 173 ENDIF 152 174 ! … … 157 179 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 158 180 zfact = 0.5_wp 159 DO_2D( 0, 1, 0, 0 )181 DO_2D( 0, 0, 0, 0 ) 160 182 IF( rnf(ji,jj) /= 0._wp ) THEN 161 183 zdep = zfact / h_rnf(ji,jj) … … 170 192 ENDIF 171 193 172 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 173 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 194 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 195 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 196 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 197 ENDIF 174 198 175 199 #if defined key_asminc … … 182 206 ! 183 207 IF( ln_linssh ) THEN 184 DO_2D( 0, 1, 0, 0 )208 DO_2D( 0, 0, 0, 0 ) 185 209 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 186 210 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim … … 188 212 END_2D 189 213 ELSE 190 DO_2D( 0, 1, 0, 0 )214 DO_2D( 0, 0, 0, 0 ) 191 215 ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 192 216 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim … … 199 223 #endif 200 224 ! 225 ! TEMP: These changes not necessary after trd_tra is tiled 201 226 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 202 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 203 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 204 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 205 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 206 DEALLOCATE( ztrdt , ztrds ) 227 DO_3D( 0, 0, 0, 0, 1, jpk ) 228 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 229 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 230 END_3D 231 232 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 233 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 234 235 ! TODO: TO BE TILED- trd_tra 236 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 237 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 238 DEALLOCATE( ztrdt , ztrds ) 239 240 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 241 ENDIF 207 242 ENDIF 208 243 !
Note: See TracChangeset
for help on using the changeset viewer.
