Changeset 10954
- Timestamp:
- 2019-05-09T18:12:29+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
- Files:
-
- 28 edited
-
OCE/ASM/asminc.F90 (modified) (6 diffs)
-
OCE/SBC/sbcisf.F90 (modified) (1 diff)
-
OCE/TRA/eosbn2.F90 (modified) (16 diffs)
-
OCE/TRA/traadv.F90 (modified) (2 diffs)
-
OCE/TRA/trabbc.F90 (modified) (1 diff)
-
OCE/TRA/trabbl.F90 (modified) (15 diffs)
-
OCE/TRA/tradmp.F90 (modified) (8 diffs)
-
OCE/TRA/traldf.F90 (modified) (4 diffs)
-
OCE/TRA/traldf_iso.F90 (modified) (10 diffs)
-
OCE/TRA/traldf_lap_blp.F90 (modified) (7 diffs)
-
OCE/TRA/traldf_triad.F90 (modified) (13 diffs)
-
OCE/TRA/tramle.F90 (modified) (6 diffs)
-
OCE/TRA/tranpc.F90 (modified) (9 diffs)
-
OCE/TRA/tranxt.F90 (modified) (17 diffs)
-
OCE/TRA/traqsr.F90 (modified) (6 diffs)
-
OCE/TRA/trasbc.F90 (modified) (14 diffs)
-
OCE/TRA/trazdf.F90 (modified) (1 diff)
-
OCE/TRA/zpshde.F90 (modified) (22 diffs)
-
OCE/TRD/trdpen.F90 (modified) (1 diff)
-
OCE/ZDF/zdfosm.F90 (modified) (1 diff)
-
OCE/nemogcm.F90 (modified) (2 diffs)
-
OCE/step.F90 (modified) (6 diffs)
-
OFF/dtadyn.F90 (modified) (2 diffs)
-
TOP/TRP/trcadv.F90 (modified) (1 diff)
-
TOP/TRP/trcbbl.F90 (modified) (5 diffs)
-
TOP/TRP/trcldf.F90 (modified) (1 diff)
-
TOP/TRP/trcnxt.F90 (modified) (3 diffs)
-
TOP/TRP/trctrp.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ASM/asminc.F90
r10425 r10954 102 102 CONTAINS 103 103 104 SUBROUTINE asm_inc_init 104 SUBROUTINE asm_inc_init( Kmm ) 105 105 !!---------------------------------------------------------------------- 106 106 !! *** ROUTINE asm_inc_init *** … … 112 112 !! ** Action : 113 113 !!---------------------------------------------------------------------- 114 INTEGER, INTENT(in) :: Kmm ! time level index 114 115 INTEGER :: ji, jj, jk, jt ! dummy loop indices 115 116 INTEGER :: imid, inum ! local integers … … 496 497 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 497 498 IF( ln_asmdin ) THEN ! Direct initialization 498 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers499 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1, Kmm ) ! Tracers 499 500 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 500 501 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH … … 505 506 506 507 507 SUBROUTINE tra_asm_inc( kt )508 SUBROUTINE tra_asm_inc( kt, Kmm ) 508 509 !!---------------------------------------------------------------------- 509 510 !! *** ROUTINE tra_asm_inc *** … … 516 517 !!---------------------------------------------------------------------- 517 518 INTEGER, INTENT(IN) :: kt ! Current time step 519 INTEGER, INTENT(IN) :: Kmm ! Current time level index 518 520 ! 519 521 INTEGER :: ji, jj, jk … … 607 609 !!gm 608 610 609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) &610 & CALL zps_hde ( kt, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) &613 & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi, &! Partial steps for top cell (ISF)614 & rhd, gru , grv , grui, grvi )! of t, s, rd at the last ocean level611 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 612 & CALL zps_hde ( kt, Kmm, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 613 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 614 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 615 & CALL zps_hde_isf( nit000, Kmm, jpts, tsb, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 616 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 615 617 616 618 DEALLOCATE( t_bkginc ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/SBC/sbcisf.F90
r10922 r10954 698 698 zdep = gdepw(ji,jj,ikt,Kmm) 699 699 ! 700 CALL eos_rab( zts, zdep, zab )700 CALL eos_rab( zts, zdep, zab, Kmm ) 701 701 ! 702 702 !! compute length scale -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/eosbn2.F90
r10425 r10954 564 564 565 565 566 SUBROUTINE rab_3d( pts, pab )566 SUBROUTINE rab_3d( pts, pab, Kmm ) 567 567 !!---------------------------------------------------------------------- 568 568 !! *** ROUTINE rab_3d *** … … 574 574 !! ** Action : - pab : thermal/haline expansion ratio at T-points 575 575 !!---------------------------------------------------------------------- 576 INTEGER , INTENT(in ) :: Kmm ! time level index 576 577 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 577 578 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio … … 592 593 DO ji = 1, jpi 593 594 ! 594 zh = gdept _n(ji,jj,jk) * r1_Z0 ! depth595 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 595 596 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 596 597 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity … … 650 651 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 651 652 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 652 zh = gdept _n(ji,jj,jk) ! depth in meters at t-point653 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 653 654 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 654 655 ! … … 677 678 678 679 679 SUBROUTINE rab_2d( pts, pdep, pab )680 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 680 681 !!---------------------------------------------------------------------- 681 682 !! *** ROUTINE rab_2d *** … … 685 686 !! ** Action : - pab : thermal/haline expansion ratio at T-points 686 687 !!---------------------------------------------------------------------- 688 INTEGER , INTENT(in ) :: Kmm ! time level index 687 689 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 688 690 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] … … 791 793 792 794 793 SUBROUTINE rab_0d( pts, pdep, pab )795 SUBROUTINE rab_0d( pts, pdep, pab, Kmm ) 794 796 !!---------------------------------------------------------------------- 795 797 !! *** ROUTINE rab_0d *** … … 799 801 !! ** Action : - pab : thermal/haline expansion ratio at T-points 800 802 !!---------------------------------------------------------------------- 803 INTEGER , INTENT(in ) :: Kmm ! time level index 801 804 REAL(wp), DIMENSION(jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 802 805 REAL(wp), INTENT(in ) :: pdep ! depth [m] … … 887 890 888 891 889 SUBROUTINE bn2( pts, pab, pn2 )892 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 890 893 !!---------------------------------------------------------------------- 891 894 !! *** ROUTINE bn2 *** … … 901 904 !! 902 905 !!---------------------------------------------------------------------- 906 INTEGER , INTENT(in ) :: Kmm ! time level index 903 907 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 904 908 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] … … 914 918 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 915 919 DO ji = 1, jpi 916 zrw = ( gdepw _n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) &917 & / ( gdept _n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )920 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 921 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 918 922 ! 919 923 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw … … 922 926 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 923 927 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 924 & / e3w _n(ji,jj,jk) * wmask(ji,jj,jk)928 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 925 929 END DO 926 930 END DO … … 1091 1095 1092 1096 1093 SUBROUTINE eos_pen( pts, pab_pe, ppen )1097 SUBROUTINE eos_pen( pts, pab_pe, ppen, Kmm ) 1094 1098 !!---------------------------------------------------------------------- 1095 1099 !! *** ROUTINE eos_pen *** … … 1111 1115 !! pab_pe(:,:,:,jp_sal) is beta_pe 1112 1116 !!---------------------------------------------------------------------- 1117 INTEGER , INTENT(in ) :: Kmm ! time level index 1113 1118 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 1114 1119 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe … … 1130 1135 DO ji = 1, jpi 1131 1136 ! 1132 zh = gdept _n(ji,jj,jk) * r1_Z0 ! depth1137 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1133 1138 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1134 1139 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity … … 1194 1199 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1195 1200 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1196 zh = gdept _n(ji,jj,jk) ! depth in meters at t-point1201 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1197 1202 ztm = tmask(ji,jj,jk) ! tmask 1198 1203 zn = 0.5_wp * zh * r1_rau0 * ztm -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv.F90
r10946 r10954 129 129 & CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 130 130 ! 131 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA' ) ! add the mle transport (if necessary)131 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary) 132 132 ! 133 133 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport … … 170 170 ENDIF 171 171 ! ! print mean trends (used for debugging) 172 IF(ln_ctl) CALL prt_ctl( tab3d_1= tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &173 & tab3d_2= tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )172 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv - Ta: ', mask1=tmask, & 173 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 174 174 ! 175 175 IF( ln_timing ) CALL timing_stop( 'tra_adv' ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbc.F90
r10946 r10954 84 84 IF( l_trdtra ) THEN ! Save the input temperature trend 85 85 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 86 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)86 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 87 87 ENDIF 88 88 ! ! Add the geothermal trend on temperature 89 89 DO jj = 2, jpjm1 90 90 DO ji = 2, jpim1 91 ts a(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))91 ts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = ts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm) 92 92 END DO 93 93 END DO 94 94 ! 95 CALL lbc_lnk( 'trabbc', ts a(:,:,:,jp_tem) , 'T', 1. )95 CALL lbc_lnk( 'trabbc', ts(:,:,:,jp_tem,Krhs) , 'T', 1. ) 96 96 ! 97 97 IF( l_trdtra ) THEN ! Send the trend for diagnostics 98 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)98 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 99 99 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 100 100 DEALLOCATE( ztrdt ) 101 101 ENDIF 102 102 ! 103 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' )103 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 104 104 ! 105 105 IF( ln_timing ) CALL timing_stop('tra_bbc') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90
r10946 r10954 89 89 90 90 91 SUBROUTINE tra_bbl( kt, K mm, Krhs )91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs ) 92 92 !!---------------------------------------------------------------------- 93 93 !! *** ROUTINE bbl *** … … 102 102 !!---------------------------------------------------------------------- 103 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 INTEGER, INTENT( in ) :: K mm, Krhs ! time level indices104 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 105 105 ! 106 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 111 111 IF( l_trdtra ) THEN !* Save the T-S input trends 112 112 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 113 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)114 ztrds(:,:,:) = ts a(:,:,:,jp_sal)115 ENDIF 116 117 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl)113 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 114 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 115 ENDIF 116 117 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA', Kbb, Kmm ) !* bbl coef. and transport (only if not already done in trcbbl) 118 118 119 119 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 120 120 ! 121 CALL tra_bbl_dif( ts b, tsa, jpts)121 CALL tra_bbl_dif( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 122 122 IF( ln_ctl ) & 123 CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, &124 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )123 CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 124 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 125 ! lateral boundary conditions ; just need for outputs 126 126 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) … … 132 132 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 133 133 ! 134 CALL tra_bbl_adv( ts b, tsa, jpts)134 CALL tra_bbl_adv( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 135 135 IF(ln_ctl) & 136 CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, &137 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )136 CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 137 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 138 138 ! lateral boundary conditions ; just need for outputs 139 139 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) … … 144 144 145 145 IF( l_trdtra ) THEN ! send the trends for further diagnostics 146 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)147 ztrds(:,:,:) = ts a(:,:,:,jp_sal) - ztrds(:,:,:)146 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 147 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 148 148 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 149 149 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 156 156 157 157 158 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )158 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt, Kmm ) 159 159 !!---------------------------------------------------------------------- 160 160 !! *** ROUTINE tra_bbl_dif *** … … 180 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 181 181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 182 INTEGER , INTENT(in ) :: Kmm ! time level indices 182 183 ! 183 184 INTEGER :: ji, jj, jn ! dummy loop indices … … 204 205 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 205 206 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 206 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,ik)207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 207 208 END DO 208 209 END DO … … 213 214 214 215 215 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )216 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt, Kmm ) 216 217 !!---------------------------------------------------------------------- 217 218 !! *** ROUTINE trc_bbl *** … … 231 232 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 232 233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 234 INTEGER , INTENT(in ) :: Kmm ! time level indices 233 235 ! 234 236 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 251 253 ! 252 254 ! ! up -slope T-point (shelf bottom point) 253 zbtr = r1_e1e2t(iis,jj) / e3t _n(iis,jj,ikus)255 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 254 256 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 255 257 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 256 258 ! 257 259 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 258 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,jk)260 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 259 261 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 260 262 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 261 263 END DO 262 264 ! 263 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,ikud)265 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 264 266 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 265 267 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 273 275 ! 274 276 ! up -slope T-point (shelf bottom point) 275 zbtr = r1_e1e2t(ji,ijs) / e3t _n(ji,ijs,ikvs)277 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 276 278 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 277 279 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 278 280 ! 279 281 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 280 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,jk)282 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 281 283 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 282 284 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 283 285 END DO 284 286 ! ! down-slope T-point (deep bottom point) 285 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,ikvd)287 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 286 288 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 287 289 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 296 298 297 299 298 SUBROUTINE bbl( kt, kit000, cdtype )300 SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) 299 301 !!---------------------------------------------------------------------- 300 302 !! *** ROUTINE bbl *** … … 325 327 INTEGER , INTENT(in ) :: kit000 ! first time step index 326 328 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 329 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index 327 330 ! 328 331 INTEGER :: ji, jj ! dummy loop indices … … 345 348 DO ji = 1, jpi 346 349 ik = mbkt(ji,jj) ! bottom T-level index 347 zts (ji,jj,jp_tem) = ts b(ji,jj,ik,jp_tem) ! bottom before T and S348 zts (ji,jj,jp_sal) = ts b(ji,jj,ik,jp_sal)350 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 351 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 349 352 ! 350 zdep(ji,jj) = gdept _n(ji,jj,ik) ! bottom T-level reference depth351 zub (ji,jj) = u n(ji,jj,mbku(ji,jj)) ! bottom velocity352 zvb (ji,jj) = v n(ji,jj,mbkv(ji,jj))353 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) ! bottom T-level reference depth 354 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) ! bottom velocity 355 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 353 356 END DO 354 357 END DO 355 358 ! 356 CALL eos_rab( zts, zdep, zab )359 CALL eos_rab( zts, zdep, zab, Kmm ) 357 360 ! 358 361 ! !-------------------! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90
r10946 r10954 72 72 73 73 74 SUBROUTINE tra_dmp( kt, K mm, Krhs )74 SUBROUTINE tra_dmp( kt, Kbb, Kmm, Krhs ) 75 75 !!---------------------------------------------------------------------- 76 76 !! *** ROUTINE tra_dmp *** … … 91 91 !!---------------------------------------------------------------------- 92 92 INTEGER, INTENT(in) :: kt ! ocean time-step index 93 INTEGER, INTENT(in) :: K mm, Krhs ! time level indices93 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 94 94 ! 95 95 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 102 102 IF( l_trdtra ) THEN !* Save ta and sa trends 103 103 ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 104 ztrdts(:,:,:,:) = ts a(:,:,:,:)104 ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs) 105 105 ENDIF 106 106 ! !== input T-S data at kt ==! … … 114 114 DO jj = 2, jpjm1 115 115 DO ji = fs_2, fs_jpim1 ! vector opt. 116 ts a(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )116 ts(ji,jj,jk,jn,Krhs) = ts(ji,jj,jk,jn,Krhs) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - ts(ji,jj,jk,jn,Kbb) ) 117 117 END DO 118 118 END DO … … 125 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 127 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts b(ji,jj,jk,jp_tem) )129 ts a(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) &130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts b(ji,jj,jk,jp_sal) )127 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) & 128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,Kbb) ) 129 ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,Kbb) ) 131 131 ENDIF 132 132 END DO … … 138 138 DO jj = 2, jpjm1 139 139 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( gdept _n(ji,jj,jk) >= hmlp (ji,jj) ) THEN141 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts b(ji,jj,jk,jp_tem) )143 ts a(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) &144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts b(ji,jj,jk,jp_sal) )140 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 141 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) & 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,Kbb) ) 143 ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,Kbb) ) 145 145 ENDIF 146 146 END DO … … 151 151 ! 152 152 IF( l_trdtra ) THEN ! trend diagnostic 153 ztrdts(:,:,:,:) = ts a(:,:,:,:) - ztrdts(:,:,:,:)153 ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 154 154 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 155 155 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) … … 157 157 ENDIF 158 158 ! ! Control print 159 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' dmp - Ta: ', mask1=tmask, &160 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )159 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, & 160 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 161 ! 162 162 IF( ln_timing ) CALL timing_stop('tra_dmp') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf.F90
r10946 r10954 47 47 CONTAINS 48 48 49 SUBROUTINE tra_ldf( kt, K mm, Krhs )49 SUBROUTINE tra_ldf( kt, Kbb, Kmm, Krhs ) 50 50 !!---------------------------------------------------------------------- 51 51 !! *** ROUTINE tra_ldf *** … … 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 INTEGER, INTENT( in ) :: K mm, Krhs ! ocean time level indices56 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! ocean time level indices 57 57 !! 58 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 63 63 IF( l_trdtra ) THEN !* Save ta and sa trends 64 64 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 65 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)66 ztrds(:,:,:) = ts a(:,:,:,jp_sal)65 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 66 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 67 67 ENDIF 68 68 ! 69 69 SELECT CASE ( nldf_tra ) !* compute lateral mixing trend and add it to the general trend 70 70 CASE ( np_lap ) ! laplacian: iso-level operator 71 CALL tra_ldf_lap ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts b, tsa, jpts, 1)71 CALL tra_ldf_lap ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, 1, Kmm ) 72 72 CASE ( np_lap_i ) ! laplacian: standard iso-neutral operator (Madec) 73 CALL tra_ldf_iso ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts b, tsb, tsa, jpts, 1)73 CALL tra_ldf_iso ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, 1, Kmm ) 74 74 CASE ( np_lap_it ) ! laplacian: triad iso-neutral operator (griffies) 75 CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts b, tsb, tsa, jpts, 1, Kmm)75 CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, 1, Kmm ) 76 76 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 77 CALL tra_ldf_blp ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts b , tsa,jpts, nldf_tra, Kmm )77 CALL tra_ldf_blp ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, nldf_tra, Kmm ) 78 78 END SELECT 79 79 ! 80 80 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 81 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)82 ztrds(:,:,:) = ts a(:,:,:,jp_sal) - ztrds(:,:,:)81 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 82 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 83 83 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 84 84 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) … … 86 86 ENDIF 87 87 ! !* print mean trends (used for debugging) 88 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' ldf - Ta: ', mask1=tmask, &89 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )88 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' ldf - Ta: ', mask1=tmask, & 89 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 90 90 ! 91 91 IF( ln_timing ) CALL timing_stop('tra_ldf') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_iso.F90
r10874 r10954 50 50 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 51 51 & pgui, pgvi, & 52 & ptb , ptbb, pta , kjpt, kpass )52 & ptb , ptbb, pta , kjpt, kpass, Kmm ) 53 53 !!---------------------------------------------------------------------- 54 54 !! *** ROUTINE tra_ldf_iso *** … … 96 96 INTEGER , INTENT(in ) :: kjpt ! number of tracers 97 97 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 98 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 98 99 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 99 100 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels … … 182 183 DO ji = 1, fs_jpim1 183 184 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 184 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w _n(ji,jj,jk) * e3w_n(ji,jj,jk) ) )185 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 185 186 END DO 186 187 END DO … … 190 191 DO jj = 1, jpjm1 191 192 DO ji = 1, fs_jpim1 192 ze3w_2 = e3w _n(ji,jj,jk) * e3w_n(ji,jj,jk)193 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 193 194 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 194 195 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt … … 255 256 DO jj = 1 , jpjm1 !== Horizontal fluxes 256 257 DO ji = 1, fs_jpim1 ! vector opt. 257 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u _n(ji,jj,jk)258 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v _n(ji,jj,jk)258 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 259 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 259 260 ! 260 261 zmsku = 1. / MAX( wmask(ji+1,jj,jk ) + wmask(ji,jj,jk+1) & … … 280 281 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 281 282 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 282 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)283 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 283 284 END DO 284 285 END DO … … 325 326 DO jj = 1, jpjm1 326 327 DO ji = fs_2, fs_jpim1 327 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w _n(ji,jj,jk) * wmask(ji,jj,jk) &328 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 328 329 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 329 330 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 340 341 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 341 342 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & 342 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w _n(ji,jj,jk) * wmask(ji,jj,jk)343 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 343 344 END DO 344 345 END DO … … 348 349 DO jj = 1, jpjm1 349 350 DO ji = fs_2, fs_jpim1 350 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w _n(ji,jj,jk) * wmask(ji,jj,jk) &351 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 351 352 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 352 353 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 361 362 DO ji = fs_2, fs_jpim1 ! vector opt. 362 363 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 363 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)364 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 364 365 END DO 365 366 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_lap_blp.F90
r10922 r10954 47 47 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 48 48 & pgui, pgvi, & 49 & ptb , pta , kjpt, kpass )49 & ptb , pta , kjpt, kpass, Kmm ) 50 50 !!---------------------------------------------------------------------- 51 51 !! *** ROUTINE tra_ldf_lap *** … … 70 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers 71 71 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 72 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 72 73 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 73 74 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels … … 100 101 DO jj = 1, jpjm1 101 102 DO ji = 1, fs_jpim1 ! vector opt. 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u _n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked!103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v _n(ji,jj,jk) !!gm * vmask(ji,jj,jk)103 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked! 104 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk) 104 105 END DO 105 106 END DO … … 140 141 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 141 142 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 142 & / ( e1e2t(ji,jj) * e3t _n(ji,jj,jk) )143 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 143 144 END DO 144 145 END DO … … 207 208 ! 208 209 CASE ( np_blp ) ! iso-level bilaplacian 209 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, zlap, kjpt, 1 )210 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, zlap, kjpt, 1, Kmm ) 210 211 CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec) 211 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )212 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1, Kmm ) 212 213 CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies) 213 214 CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1, Kmm ) … … 216 217 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 217 218 ! ! Partial top/bottom cell: GRADh( zlap ) 218 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom219 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, kjpt, zlap, zglu, zglv ) ! only bottom219 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom 220 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, Kmm, kjpt, zlap, zglu, zglv ) ! only bottom 220 221 ENDIF 221 222 ! … … 223 224 ! 224 225 CASE ( np_blp ) ! iso-level bilaplacian 225 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta, kjpt, 2 )226 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta, kjpt, 2, Kmm ) 226 227 CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec) 227 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )228 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2, Kmm ) 228 229 CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies) 229 230 CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2, Kmm ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_triad.F90
r10922 r10954 143 143 DO jj = 1, jpjm1 144 144 DO ji = 1, fs_jpim1 145 ze3wr = 1._wp / e3w _n(ji+ip,jj,jk+kp)146 zbu = e1e2u(ji,jj) * e3u _n(ji,jj,jk)145 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 146 zbu = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 147 147 zah = 0.25_wp * pahu(ji,jj,jk) 148 148 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 149 149 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 150 zslope2 = zslope_skew + ( gdept _n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)150 zslope2 = zslope_skew + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 151 151 zslope2 = zslope2 *zslope2 152 152 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 … … 167 167 DO jj = 1, jpjm1 168 168 DO ji = 1, fs_jpim1 169 ze3wr = 1.0_wp / e3w _n(ji,jj+jp,jk+kp)170 zbv = e1e2v(ji,jj) * e3v _n(ji,jj,jk)169 ze3wr = 1.0_wp / e3w(ji,jj+jp,jk+kp,Kmm) 170 zbv = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 171 171 zah = 0.25_wp * pahv(ji,jj,jk) 172 172 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 173 173 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 174 174 ! (do this by *adding* gradient of depth) 175 zslope2 = zslope_skew + ( gdept _n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)175 zslope2 = zslope_skew + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 176 176 zslope2 = zslope2 * zslope2 177 177 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 … … 194 194 DO ji = 1, fs_jpim1 195 195 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 196 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w _n(ji,jj,jk) * e3w_n(ji,jj,jk) ) )196 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 197 197 END DO 198 198 END DO … … 202 202 DO jj = 1, jpjm1 203 203 DO ji = 1, fs_jpim1 204 ze3w_2 = e3w _n(ji,jj,jk) * e3w_n(ji,jj,jk)204 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 205 205 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 206 206 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt … … 274 274 ze1ur = r1_e1u(ji,jj) 275 275 zdxt = zdit(ji,jj,jk) * ze1ur 276 ze3wr = 1._wp / e3w _n(ji+ip,jj,jk+kp)276 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 277 277 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 278 278 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 279 279 zslope_iso = triadi (ji+ip,jj,jk,1-ip,kp) 280 280 ! 281 zbu = 0.25_wp * e1e2u(ji,jj) * e3u _n(ji,jj,jk)281 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 282 282 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 283 283 zah = pahu(ji,jj,jk) … … 297 297 ze2vr = r1_e2v(ji,jj) 298 298 zdyt = zdjt(ji,jj,jk) * ze2vr 299 ze3wr = 1._wp / e3w _n(ji,jj+jp,jk+kp)299 ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 300 300 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 301 301 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 302 302 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 303 zbv = 0.25_wp * e1e2v(ji,jj) * e3v _n(ji,jj,jk)303 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 304 304 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahv is masked... 305 305 zah = pahv(ji,jj,jk) … … 321 321 ze1ur = r1_e1u(ji,jj) 322 322 zdxt = zdit(ji,jj,jk) * ze1ur 323 ze3wr = 1._wp / e3w _n(ji+ip,jj,jk+kp)323 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 324 324 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 325 325 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 326 326 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 327 327 ! 328 zbu = 0.25_wp * e1e2u(ji,jj) * e3u _n(ji,jj,jk)328 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 329 329 ! ln_botmix_triad is .F. mask zah for bottom half cells 330 330 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? … … 344 344 ze2vr = r1_e2v(ji,jj) 345 345 zdyt = zdjt(ji,jj,jk) * ze2vr 346 ze3wr = 1._wp / e3w _n(ji,jj+jp,jk+kp)346 ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 347 347 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 348 348 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 349 349 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 350 zbv = 0.25_wp * e1e2v(ji,jj) * e3v _n(ji,jj,jk)350 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 351 351 ! ln_botmix_triad is .F. mask zah for bottom half cells 352 352 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? … … 365 365 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) & 366 366 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk) ) & 367 & / ( e1e2t(ji,jj) * e3t _n(ji,jj,jk) )367 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 368 368 END DO 369 369 END DO … … 376 376 DO jj = 1, jpjm1 377 377 DO ji = fs_2, fs_jpim1 378 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w _n(ji,jj,jk) * tmask(ji,jj,jk) &378 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 379 379 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 380 380 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 388 388 DO jj = 1, jpjm1 389 389 DO ji = fs_2, fs_jpim1 390 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w _n(ji,jj,jk) * tmask(ji,jj,jk) &390 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 391 391 & * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 392 392 END DO … … 397 397 DO jj = 1, jpjm1 398 398 DO ji = fs_2, fs_jpim1 399 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w _n(ji,jj,jk) * tmask(ji,jj,jk) &399 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 400 400 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 401 401 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 410 410 DO ji = fs_2, fs_jpim1 ! vector opt. 411 411 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 412 & / ( e1e2t(ji,jj) * e3t _n(ji,jj,jk) )412 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 413 413 END DO 414 414 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tramle.F90
r10425 r10954 56 56 CONTAINS 57 57 58 SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype )58 SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype, Kmm ) 59 59 !!---------------------------------------------------------------------- 60 60 !! *** ROUTINE tra_mle_trp *** … … 71 71 !! p.n = p.n + z._mle 72 72 !! 73 !! ** Action : - (pu n,pvn,pwn) increased by the mle transport73 !! ** Action : - (pu,pv,pw) increased by the mle transport 74 74 !! CAUTION, the transport is not updated at the last line/raw 75 75 !! this may be a problem for some advection schemes … … 80 80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 81 INTEGER , INTENT(in ) :: kit000 ! first time step index 82 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 82 83 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 83 84 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu ! in : 3 ocean transport components … … 115 116 DO jj = 1, jpj 116 117 DO ji = 1, jpi 117 zc = e3t _n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points118 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 118 119 zmld(ji,jj) = zmld(ji,jj) + zc 119 120 zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 … … 147 148 END SELECT 148 149 ! ! convert density into buoyancy 149 zbm(:,:) = + grav * zbm(:,:) / MAX( e3t _n(:,:,1), zmld(:,:) )150 zbm(:,:) = + grav * zbm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 150 151 ! 151 152 ! … … 205 206 DO jj = 1, jpjm1 206 207 DO ji = 1, fs_jpim1 ! vector opt. 207 zcuw = 1._wp - ( gdepw _n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj)208 zcvw = 1._wp - ( gdepw _n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj)208 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 209 zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) 209 210 zcuw = zcuw * zcuw 210 211 zcvw = zcvw * zcvw -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranpc.F90
r10946 r10954 85 85 IF( l_trdtra ) THEN !* Save initial after fields 86 86 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 87 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)88 ztrds(:,:,:) = ts a(:,:,:,jp_sal)87 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 88 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 89 89 ENDIF 90 90 ! … … 96 96 ENDIF 97 97 ! 98 CALL eos_rab( ts a, zab) ! after alpha and beta (given on T-points)99 CALL bn2 ( ts a, zab, zn2) ! after Brunt-Vaisala (given on W-points)98 CALL eos_rab( ts(:,:,:,:,Krhs), zab, Kmm ) ! after alpha and beta (given on T-points) 99 CALL bn2 ( ts(:,:,:,:,Krhs), zab, zn2, Kmm ) ! after Brunt-Vaisala (given on W-points) 100 100 ! 101 101 inpcc = 0 … … 106 106 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points 107 107 ! ! consider one ocean column 108 zvts(:,jp_tem) = ts a(ji,jj,:,jp_tem) ! temperature109 zvts(:,jp_sal) = ts a(ji,jj,:,jp_sal) ! salinity108 zvts(:,jp_tem) = ts(ji,jj,:,jp_tem,Krhs) ! temperature 109 zvts(:,jp_sal) = ts(ji,jj,:,jp_sal,Krhs) ! salinity 110 110 ! 111 111 zvab(:,jp_tem) = zab(ji,jj,:,jp_tem) ! Alpha … … 187 187 DO jk = ikup, ikbot ! Inside the instable (and overlying neutral) portion of the column 188 188 ! 189 zdz = e3t _n(ji,jj,jk)189 zdz = e3t(ji,jj,jk,Kmm) 190 190 zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 191 191 zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz … … 236 236 237 237 !! Interpolating alfa and beta at W point: 238 zrw = (gdepw _n(ji,jj,jk ) - gdept_n(ji,jj,jk)) &239 & / (gdept _n(ji,jj,jk-1) - gdept_n(ji,jj,jk))238 zrw = (gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm)) & 239 & / (gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm)) 240 240 zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 241 241 zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw … … 244 244 zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) & 245 245 & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) & 246 & / e3w _n(ji,jj,jk) * tmask(ji,jj,jk)246 & / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 247 247 248 248 !! OR, faster => just considering the vertical gradient of density … … 288 288 289 289 !! Updating tsa: 290 ts a(ji,jj,:,jp_tem) = zvts(:,jp_tem)291 ts a(ji,jj,:,jp_sal) = zvts(:,jp_sal)290 ts(ji,jj,:,jp_tem,Krhs) = zvts(:,jp_tem) 291 ts(ji,jj,:,jp_sal,Krhs) = zvts(:,jp_sal) 292 292 293 293 !! LB: Potentially some other global variable beside theta and S can be treated here … … 303 303 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 304 304 z1_r2dt = 1._wp / (2._wp * rdt) 305 ztrdt(:,:,:) = ( ts a(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt306 ztrds(:,:,:) = ( ts a(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt305 ztrdt(:,:,:) = ( ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) ) * z1_r2dt 306 ztrds(:,:,:) = ( ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) ) * z1_r2dt 307 307 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 308 308 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) … … 310 310 ENDIF 311 311 ! 312 CALL lbc_lnk_multi( 'tranpc', ts a(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )312 CALL lbc_lnk_multi( 'tranpc', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 313 313 ! 314 314 IF( lwp .AND. l_LB_debug ) THEN -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranxt.F90
r10946 r10954 64 64 CONTAINS 65 65 66 SUBROUTINE tra_nxt( kt, K mm, Krhs )66 SUBROUTINE tra_nxt( kt, Kbb, Kmm, Krhs ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE tranxt *** … … 84 84 !! domains (lk_agrif=T) 85 85 !! 86 !! ** Action : - ts b & tsnready for the next time step86 !! ** Action : - ts(Kbb) & ts(Kmm) ready for the next time step 87 87 !!---------------------------------------------------------------------- 88 88 INTEGER, INTENT(in) :: kt ! ocean time-step index 89 INTEGER, INTENT(in) :: K mm, Krhs ! time level indices89 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 90 90 !! 91 91 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 108 108 #endif 109 109 ! ! local domain boundaries (T-point, unchanged sign) 110 CALL lbc_lnk_multi( 'tranxt', ts a(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )110 CALL lbc_lnk_multi( 'tranxt', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 111 111 ! 112 112 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries … … 128 128 ! total trend for the non-time-filtered variables. 129 129 zfact = 1.0 / rdt 130 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts nterms130 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms 131 131 DO jk = 1, jpkm1 132 ztrdt(:,:,jk) = ( ts a(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact133 ztrds(:,:,jk) = ( ts a(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact132 ztrdt(:,:,jk) = ( ts(:,:,jk,jp_tem,Krhs)*e3t(:,:,jk,Krhs) / e3t(:,:,jk,Kmm) - ts(:,:,jk,jp_tem,Kmm)) * zfact 133 ztrds(:,:,jk) = ( ts(:,:,jk,jp_sal,Krhs)*e3t(:,:,jk,Krhs) / e3t(:,:,jk,Kmm) - ts(:,:,jk,jp_sal,Kmm)) * zfact 134 134 END DO 135 135 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 138 138 ! Store now fields before applying the Asselin filter 139 139 ! in order to calculate Asselin filter trend later. 140 ztrdt(:,:,:) = ts n(:,:,:,jp_tem)141 ztrds(:,:,:) = ts n(:,:,:,jp_sal)140 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Kmm) 141 ztrds(:,:,:) = ts(:,:,:,jp_sal,Kmm) 142 142 ENDIF 143 143 ENDIF … … 146 146 DO jn = 1, jpts 147 147 DO jk = 1, jpkm1 148 ts n(:,:,jk,jn) = tsa(:,:,jk,jn)148 ts(:,:,jk,jn,Kmm) = ts(:,:,jk,jn,Krhs) 149 149 END DO 150 150 END DO … … 159 159 ELSE ! Leap-Frog + Asselin filter time stepping 160 160 ! 161 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface 162 ELSE ; CALL tra_nxt_vvl( kt, Kmm, Krhs, nit000, rdt, 'TRA', tsb, tsn, tsa, & 163 & sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 164 ENDIF 165 ! 166 CALL lbc_lnk_multi( 'tranxt', tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., & 167 & tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., & 168 & tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. ) 161 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, Kmm, nit000, 'TRA', & 162 & ts(:,:,:,:,Kbb), ts(:,:,:,:,Kmm), ts(:,:,:,:,Krhs), jpts ) ! linear free surface 163 ELSE ; CALL tra_nxt_vvl( kt, Kbb, Kmm, Krhs, nit000, rdt, 'TRA', & 164 & ts(:,:,:,:,Kbb), ts(:,:,:,:,Kmm), ts(:,:,:,:,Krhs), & 165 & sbc_tsc , sbc_tsc_b , jpts ) ! non-linear free surface 166 ENDIF 167 ! 168 CALL lbc_lnk_multi( 'tranxt', ts(:,:,:,jp_tem,Kbb) , 'T', 1., ts(:,:,:,jp_sal,Kbb) , 'T', 1., & 169 & ts(:,:,:,jp_tem,Kmm) , 'T', 1., ts(:,:,:,jp_sal,Kmm) , 'T', 1., & 170 & ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 169 171 ! 170 172 ENDIF … … 173 175 zfact = 1._wp / r2dt 174 176 DO jk = 1, jpkm1 175 ztrdt(:,:,jk) = ( ts b(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact176 ztrds(:,:,jk) = ( ts b(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact177 ztrdt(:,:,jk) = ( ts(:,:,jk,jp_tem,Kbb) - ztrdt(:,:,jk) ) * zfact 178 ztrds(:,:,jk) = ( ts(:,:,jk,jp_sal,Kbb) - ztrds(:,:,jk) ) * zfact 177 179 END DO 178 180 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_atf, ztrdt ) … … 182 184 ! 183 185 ! ! control print 184 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &185 & tab3d_2=ts n(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )186 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' nxt - Tn: ', mask1=tmask, & 187 & tab3d_2=ts(:,:,:,jp_sal,Kmm), clinfo2= ' Sn: ', mask2=tmask ) 186 188 ! 187 189 IF( ln_timing ) CALL timing_stop('tra_nxt') … … 190 192 191 193 192 SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )194 SUBROUTINE tra_nxt_fix( kt, Kmm, kit000, cdtype, ptb, ptn, pta, kjpt ) 193 195 !!---------------------------------------------------------------------- 194 196 !! *** ROUTINE tra_nxt_fix *** … … 200 202 !! - swap tracer fields to prepare the next time_step. 201 203 !! 202 !! ** Action : - tsb & tsn ready for the next time step204 !! ** Action : - ptb & ptn ready for the next time step 203 205 !!---------------------------------------------------------------------- 204 206 INTEGER , INTENT(in ) :: kt ! ocean time-step index 207 INTEGER , INTENT(in ) :: Kmm ! time level index 205 208 INTEGER , INTENT(in ) :: kit000 ! first time step index 206 209 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 239 242 240 243 241 SUBROUTINE tra_nxt_vvl( kt, K mm, Krhs, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )244 SUBROUTINE tra_nxt_vvl( kt, Kbb, Kmm, Krhs, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 242 245 !!---------------------------------------------------------------------- 243 246 !! *** ROUTINE tra_nxt_vvl *** … … 248 251 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 249 252 !! - swap tracer fields to prepare the next time_step. 250 !! tb = ( e3t _n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )251 !! /( e3t _n + atfp*[ e3t_b - 2 e3t_n + e3t_a] )253 !! tb = ( e3t(Kmm)*tn + atfp*[ e3t(Kbb)*tb - 2 e3t(Kmm)*tn + e3t_a*ta ] ) 254 !! /( e3t(Kmm) + atfp*[ e3t(Kbb) - 2 e3t(Kmm) + e3t(Krhs) ] ) 252 255 !! tn = ta 253 256 !! 254 !! ** Action : - tsb & tsn ready for the next time step257 !! ** Action : - ptb & ptn ready for the next time step 255 258 !!---------------------------------------------------------------------- 256 259 INTEGER , INTENT(in ) :: kt ! ocean time-step index 257 INTEGER , INTENT(in ) :: K mm, Krhs ! time level indices260 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 258 261 INTEGER , INTENT(in ) :: kit000 ! first time step index 259 262 REAL(wp) , INTENT(in ) :: p2dt ! time-step … … 300 303 DO jj = 2, jpjm1 301 304 DO ji = fs_2, fs_jpim1 302 ze3t_b = e3t _b(ji,jj,jk)303 ze3t_n = e3t _n(ji,jj,jk)304 ze3t_a = e3t _a(ji,jj,jk)305 ze3t_b = e3t(ji,jj,jk,Kbb) 306 ze3t_n = e3t(ji,jj,jk,Kmm) 307 ze3t_a = e3t(ji,jj,jk,Krhs) 305 308 ! ! tracer content at Before, now and after 306 309 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b … … 323 326 IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj) ) THEN 324 327 ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) ) & 325 & * ( e3t _n(ji,jj,jk) / h_rnf(ji,jj) )328 & * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) ) 326 329 ENDIF 327 330 ELSE … … 339 342 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 340 343 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 341 & * e3t _n(ji,jj,jk) / h_rnf(ji,jj)344 & * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) 342 345 ! 343 346 ! ice shelf … … 346 349 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 347 350 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 348 & * e3t _n(ji,jj,jk) * r1_hisf_tbl (ji,jj)351 & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) 349 352 ! level partially include in Losch_2008 ice shelf boundary layer 350 353 IF ( jk == misfkb(ji,jj) ) & 351 354 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 352 & * e3t _n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)355 & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 353 356 END IF 354 357 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traqsr.F90
r10946 r10954 127 127 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 128 128 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 129 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)129 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 130 130 ENDIF 131 131 ! … … 173 173 zze = 568.2 * zCtot**(-0.746) 174 174 IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 175 zpsi = gdepw _n(ji,jj,jk) / zze175 zpsi = gdepw(ji,jj,jk,Kmm) / zze 176 176 ! 177 177 zlogc = LOG( zchl ) … … 219 219 DO jj = 2, jpjm1 220 220 DO ji = fs_2, fs_jpim1 221 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t _n(ji,jj,jk-1) * xsi0r )222 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t _n(ji,jj,jk-1) * zekb(ji,jj) )223 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t _n(ji,jj,jk-1) * zekg(ji,jj) )224 zc3 = ze3(ji,jj,jk-1) * EXP( - e3t _n(ji,jj,jk-1) * zekr(ji,jj) )221 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r ) 222 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 223 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 224 zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 225 225 ze0(ji,jj,jk) = zc0 226 226 ze1(ji,jj,jk) = zc1 … … 249 249 DO jj = 2, jpjm1 250 250 DO ji = fs_2, fs_jpim1 251 zc0 = zz0 * EXP( -gdepw _n(ji,jj,jk )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk)*xsi1r )252 zc1 = zz0 * EXP( -gdepw _n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )251 zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r ) 252 zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 253 253 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 254 254 END DO … … 262 262 DO jj = 2, jpjm1 !-----------------------------! 263 263 DO ji = fs_2, fs_jpim1 ! vector opt. 264 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &265 & + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t _n(ji,jj,jk)264 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) & 265 & + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 266 266 END DO 267 267 END DO … … 296 296 ! 297 297 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 298 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)298 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 299 299 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 300 300 DEALLOCATE( ztrdt ) 301 301 ENDIF 302 302 ! ! print mean trends (used for debugging) 303 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' )303 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 304 304 ! 305 305 IF( ln_timing ) CALL timing_stop('tra_qsr') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trasbc.F90
r10946 r10954 63 63 !! (2) Fwe , tracer carried with the water that is exchanged with air+ice. 64 64 !! The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe, 65 !! they are simply added to the tracer trend (ts a).65 !! they are simply added to the tracer trend (ts(Krhs)). 66 66 !! In linear free surface case (ln_linssh=T), the volume of the 67 67 !! ocean does not change with the water exchanges at the (air+ice)-sea … … 69 69 !! concentration/dilution effect associated with water exchanges. 70 70 !! 71 !! ** Action : - Update ts awith the surface boundary condition trend71 !! ** Action : - Update ts(Krhs) with the surface boundary condition trend 72 72 !! - send trends to trdtra module for further diagnostics(l_trdtra=T) 73 73 !!---------------------------------------------------------------------- … … 91 91 IF( l_trdtra ) THEN !* Save ta and sa trends 92 92 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 93 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)94 ztrds(:,:,:) = ts a(:,:,:,jp_sal)93 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 94 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 95 95 ENDIF 96 96 ! … … 132 132 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 133 133 DO ji = fs_2, fs_jpim1 ! vector opt. 134 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * ts n(ji,jj,1,jp_tem)135 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * ts n(ji,jj,1,jp_sal)134 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * ts(ji,jj,1,jp_tem,Kmm) 135 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * ts(ji,jj,1,jp_sal,Kmm) 136 136 END DO 137 137 END DO !==>> output c./d. term 138 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * ts n(:,:,1,jp_tem) )139 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * ts n(:,:,1,jp_sal) )138 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * ts(:,:,1,jp_tem,Kmm) ) 139 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * ts(:,:,1,jp_sal,Kmm) ) 140 140 ENDIF 141 141 ! … … 143 143 DO jj = 2, jpj 144 144 DO ji = fs_2, fs_jpim1 ! vector opt. 145 ts a(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)145 ts(ji,jj,1,jn,Krhs) = ts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm) 146 146 END DO 147 147 END DO … … 174 174 DO jk = ikt, ikb - 1 175 175 ! compute trend 176 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &176 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) & 177 177 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) & 178 178 & * r1_hisf_tbl(ji,jj) … … 181 181 ! level partially include in ice shelf boundary layer 182 182 ! compute trend 183 ts a(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem) &183 ts(ji,jj,ikb,jp_tem,Krhs) = ts(ji,jj,ikb,jp_tem,Krhs) & 184 184 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) & 185 185 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) … … 200 200 zdep = zfact / h_rnf(ji,jj) 201 201 DO jk = 1, nk_rnf(ji,jj) 202 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &202 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) & 203 203 & + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 204 IF( ln_rnf_sal ) ts a(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) &204 IF( ln_rnf_sal ) ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs) & 205 205 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 206 206 END DO … … 210 210 ENDIF 211 211 212 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*ts n(:,:,1,jp_tem) ) ! runoff term on sst213 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*ts n(:,:,1,jp_sal) ) ! runoff term on sss212 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*ts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 213 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*ts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 214 214 215 215 #if defined key_asminc … … 224 224 DO jj = 2, jpj 225 225 DO ji = fs_2, fs_jpim1 226 ztim = ssh_iau(ji,jj) / e3t _n(ji,jj,1)227 ts a(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * ztim228 ts a(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * ztim226 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 227 ts(ji,jj,1,jp_tem,Krhs) = ts(ji,jj,1,jp_tem,Krhs) + ts(ji,jj,1,jp_tem,Kmm) * ztim 228 ts(ji,jj,1,jp_sal,Krhs) = ts(ji,jj,1,jp_sal,Krhs) + ts(ji,jj,1,jp_sal,Kmm) * ztim 229 229 END DO 230 230 END DO … … 233 233 DO ji = fs_2, fs_jpim1 234 234 ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) ) 235 ts a(ji,jj,:,jp_tem) = tsa(ji,jj,:,jp_tem) + tsn(ji,jj,:,jp_tem) * ztim236 ts a(ji,jj,:,jp_sal) = tsa(ji,jj,:,jp_sal) + tsn(ji,jj,:,jp_sal) * ztim235 ts(ji,jj,:,jp_tem,Krhs) = ts(ji,jj,:,jp_tem,Krhs) + ts(ji,jj,:,jp_tem,Kmm) * ztim 236 ts(ji,jj,:,jp_sal,Krhs) = ts(ji,jj,:,jp_sal,Krhs) + ts(ji,jj,:,jp_sal,Kmm) * ztim 237 237 END DO 238 238 END DO … … 251 251 DO jj = 2, jpj 252 252 DO ji = fs_2, fs_jpim1 253 zdep = 1._wp / e3t _n(ji,jj,jk)254 ts a(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep255 ts a(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep253 zdep = 1._wp / e3t(ji,jj,jk,Kmm) 254 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep 255 ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep 256 256 END DO 257 257 END DO … … 260 260 261 261 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 262 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)263 ztrds(:,:,:) = ts a(:,:,:,jp_sal) - ztrds(:,:,:)262 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 263 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 264 264 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 265 265 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) … … 267 267 ENDIF 268 268 ! 269 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' sbc - Ta: ', mask1=tmask, &270 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )269 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, & 270 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 271 271 ! 272 272 IF( ln_timing ) CALL timing_stop('tra_sbc') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trazdf.F90
r10946 r10954 101 101 ENDIF 102 102 ! ! print mean trends (used for debugging) 103 IF(ln_ctl) CALL prt_ctl( tab3d_1= tsa(:,:,:,jp_tem), clinfo1=' zdf - Ta: ', mask1=tmask, &104 & tab3d_2= tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )103 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, & 104 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 105 105 ! 106 106 IF( ln_timing ) CALL timing_stop('tra_zdf') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/zpshde.F90
r10425 r10954 39 39 CONTAINS 40 40 41 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, &41 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 42 42 & prd, pgru, pgrv ) 43 43 !!---------------------------------------------------------------------- … … 85 85 !!---------------------------------------------------------------------- 86 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 87 88 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 89 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields … … 109 110 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 110 111 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 111 !!gm BUG ? when applied to before fields, e3w _bshould be used....112 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)113 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)112 !!gm BUG ? when applied to before fields, e3w(:,:,:,Kbb) should be used.... 113 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 114 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 114 115 ! 115 116 ! i- direction 116 117 IF( ze3wu >= 0._wp ) THEN ! case 1 117 zmaxu = ze3wu / e3w _n(ji+1,jj,iku)118 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 118 119 ! interpolated values of tracers 119 120 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 121 122 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 122 123 ELSE ! case 2 123 zmaxu = -ze3wu / e3w _n(ji,jj,iku)124 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 124 125 ! interpolated values of tracers 125 126 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 130 131 ! j- direction 131 132 IF( ze3wv >= 0._wp ) THEN ! case 1 132 zmaxv = ze3wv / e3w _n(ji,jj+1,ikv)133 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 133 134 ! interpolated values of tracers 134 135 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 136 137 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 137 138 ELSE ! case 2 138 zmaxv = -ze3wv / e3w _n(ji,jj,ikv)139 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 139 140 ! interpolated values of tracers 140 141 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 155 156 iku = mbku(ji,jj) 156 157 ikv = mbkv(ji,jj) 157 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)158 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)159 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1160 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2161 ENDIF 162 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1163 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2158 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 159 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 160 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 161 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 162 ENDIF 163 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 164 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 164 165 ENDIF 165 166 END DO … … 173 174 iku = mbku(ji,jj) 174 175 ikv = mbkv(ji,jj) 175 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)176 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)176 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 177 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 177 178 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 178 179 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 … … 192 193 193 194 194 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, &195 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 195 196 & prd, pgru, pgrv, pgrui, pgrvi ) 196 197 !!---------------------------------------------------------------------- … … 241 242 !!---------------------------------------------------------------------- 242 243 INTEGER , INTENT(in ) :: kt ! ocean time-step index 244 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 243 245 INTEGER , INTENT(in ) :: kjpt ! number of tracers 244 246 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields … … 270 272 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 271 273 ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 272 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)273 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)274 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 275 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 274 276 ! 275 277 ! i- direction 276 278 IF( ze3wu >= 0._wp ) THEN ! case 1 277 zmaxu = ze3wu / e3w _n(ji+1,jj,iku)279 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 278 280 ! interpolated values of tracers 279 281 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 281 283 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 282 284 ELSE ! case 2 283 zmaxu = -ze3wu / e3w _n(ji,jj,iku)285 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 284 286 ! interpolated values of tracers 285 287 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 290 292 ! j- direction 291 293 IF( ze3wv >= 0._wp ) THEN ! case 1 292 zmaxv = ze3wv / e3w _n(ji,jj+1,ikv)294 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 293 295 ! interpolated values of tracers 294 296 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 296 298 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 297 299 ELSE ! case 2 298 zmaxv = -ze3wv / e3w _n(ji,jj,ikv)300 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 299 301 ! interpolated values of tracers 300 302 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 318 320 iku = mbku(ji,jj) 319 321 ikv = mbkv(ji,jj) 320 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)321 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)322 ! 323 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1324 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2325 ENDIF 326 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1327 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2322 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 323 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 324 ! 325 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 326 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 327 ENDIF 328 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 329 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 328 330 ENDIF 329 331 … … 340 342 iku = mbku(ji,jj) 341 343 ikv = mbkv(ji,jj) 342 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)343 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)344 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 345 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 344 346 345 347 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 … … 369 371 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 370 372 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 371 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)372 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)373 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 374 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 373 375 374 376 ! i- direction 375 377 IF( ze3wu >= 0._wp ) THEN ! case 1 376 zmaxu = ze3wu / e3w _n(ji+1,jj,ikup1)378 zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 377 379 ! interpolated values of tracers 378 380 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) … … 380 382 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 381 383 ELSE ! case 2 382 zmaxu = - ze3wu / e3w _n(ji,jj,ikup1)384 zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 383 385 ! interpolated values of tracers 384 386 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) … … 389 391 ! j- direction 390 392 IF( ze3wv >= 0._wp ) THEN ! case 1 391 zmaxv = ze3wv / e3w _n(ji,jj+1,ikvp1)393 zmaxv = ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 392 394 ! interpolated values of tracers 393 395 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) … … 395 397 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 396 398 ELSE ! case 2 397 zmaxv = - ze3wv / e3w _n(ji,jj,ikvp1)399 zmaxv = - ze3wv / e3w(ji,jj,ikvp1,Kmm) 398 400 ! interpolated values of tracers 399 401 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) … … 416 418 iku = miku(ji,jj) 417 419 ikv = mikv(ji,jj) 418 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)419 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)420 ! 421 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1422 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2423 ENDIF 424 425 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1426 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2420 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 421 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 422 ! 423 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 424 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 425 ENDIF 426 427 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 428 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 427 429 ENDIF 428 430 … … 437 439 iku = miku(ji,jj) 438 440 ikv = mikv(ji,jj) 439 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)440 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)441 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 442 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 441 443 442 444 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRD/trdpen.F90
r10946 r10954 78 78 IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step 79 79 nkstp = kt 80 CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe )80 CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 81 81 CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 82 82 CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ZDF/zdfosm.F90
r10946 r10954 1584 1584 ALLOCATE( imld_rst(jpi,jpj) ) 1585 1585 ! w-level of the mixing and mixed layers 1586 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n )1587 CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2 )1586 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 1587 CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 1588 1588 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 1589 1589 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/nemogcm.F90
r10946 r10954 435 435 CALL dia_obs( nit000 - 1, Nnn ) ! Observation operator for restart 436 436 ENDIF 437 IF( lk_asminc ) CALL asm_inc_init 437 IF( lk_asminc ) CALL asm_inc_init( Nnn ) ! Assimilation increments 438 438 ! 439 439 RETURN ! end of initialization … … 497 497 498 498 ! ! Assimilation increments 499 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments499 IF( lk_asminc ) CALL asm_inc_init( Nnn ) ! Initialize assimilation increments 500 500 ! 501 501 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90
r10946 r10954 131 131 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 132 132 ! THERMODYNAMICS 133 CALL eos_rab( tsb, rab_b ) ! before local thermal/haline expension ratio at T-points134 CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points135 CALL bn2 ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency136 CALL bn2 ( tsn, rab_n, rn2 ) ! now Brunt-Vaisala frequency133 CALL eos_rab( tsb, rab_b, Nnn ) ! before local thermal/haline expension ratio at T-points 134 CALL eos_rab( tsn, rab_n, Nnn ) ! now local thermal/haline expension ratio at T-points 135 CALL bn2 ( tsb, rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 136 CALL bn2 ( tsn, rab_n, rn2, Nnn ) ! now Brunt-Vaisala frequency 137 137 138 138 ! VERTICAL PHYSICS … … 144 144 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 145 145 146 IF( ln_zps .AND. .NOT. ln_isfcav) &147 & CALL zps_hde ( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient148 & rhd, gru , grv ) ! of t, s, rd at the last ocean level149 150 IF( ln_zps .AND. ln_isfcav) &151 & CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF)152 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level146 IF( ln_zps .AND. .NOT. ln_isfcav) & 147 & CALL zps_hde ( kstp, Nnn, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 148 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 149 150 IF( ln_zps .AND. ln_isfcav) & 151 & CALL zps_hde_isf( kstp, Nnn, jpts, tsb, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 152 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 153 153 IF( ln_traldf_triad ) THEN 154 154 CALL ldf_slp_triad( kstp, Nbb, Nnn ) ! before slope for triad operator … … 175 175 !! but ensures reproductible results 176 176 !! with previous versions using split-explicit free surface 177 IF( ln_zps .AND. .NOT. ln_isfcav ) &178 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient179 & rhd, gru , grv ) ! of t, s, rd at the last ocean level180 IF( ln_zps .AND. ln_isfcav ) &181 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF)182 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level177 IF( ln_zps .AND. .NOT. ln_isfcav ) & 178 & CALL zps_hde ( kstp, Nnn, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient 179 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 180 IF( ln_zps .AND. ln_isfcav ) & 181 & CALL zps_hde_isf( kstp, Nnn, jpts, tsn, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 182 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 183 183 !!jc: fs simplification 184 184 … … 241 241 242 242 IF( lk_asminc .AND. ln_asmiau .AND. & 243 & ln_trainc ) CALL tra_asm_inc ( kstp ) ! apply tracer assimilation increment243 & ln_trainc ) CALL tra_asm_inc ( kstp, Nnn ) ! apply tracer assimilation increment 244 244 CALL tra_sbc ( kstp, Nnn, Nrhs ) ! surface boundary condition 245 245 IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, Nrhs ) ! penetrative solar radiation qsr 246 246 IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, Nrhs ) ! bottom heat flux 247 IF( ln_trabbl ) CALL tra_bbl ( kstp, N nn, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme248 IF( ln_tradmp ) CALL tra_dmp ( kstp, N nn, Nrhs ) ! internal damping trends247 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme 248 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, Nrhs ) ! internal damping trends 249 249 IF( ln_bdy ) CALL bdy_tra_dmp ( kstp ) ! bdy damping trends 250 250 #if defined key_agrif … … 255 255 IF( ln_zdfosm ) CALL tra_osm( kstp, Nnn , ts, Nrhs ) ! OSMOSIS non-local tracer fluxes ==> RHS 256 256 IF( lrst_oce .AND. ln_zdfosm ) & 257 & CALL osm_rst( kstp, Nnn, 'WRITE' )! write OSMOSIS outputs + wn (so must do here) to restarts258 CALL tra_ldf( kstp, N nn, Nrhs )! lateral mixing257 & CALL osm_rst( kstp, Nnn, 'WRITE' ) ! write OSMOSIS outputs + wn (so must do here) to restarts 258 CALL tra_ldf( kstp, Nbb, Nnn, Nrhs ) ! lateral mixing 259 259 260 260 !!gm : why CALL to dia_ptr has been moved here??? (use trends info?) … … 281 281 !! 282 282 !!jc2: dynnxt must be the latest call. e3t_b are indeed updated in that routine 283 CALL tra_nxt ( kstp, N nn, Nrhs ) ! finalize (bcs) tracer fields at next time step and swap284 CALL dyn_nxt ( kstp, Nnn ) ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt)283 CALL tra_nxt ( kstp, Nbb, Nnn, Nrhs ) ! finalize (bcs) tracer fields at next time step and swap 284 CALL dyn_nxt ( kstp, Nnn ) ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt) 285 285 CALL ssh_swp ( kstp ) ! swap of sea surface height 286 286 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OFF/dtadyn.F90
r10922 r10954 159 159 ! 160 160 CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 161 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n ) ! now local thermal/haline expension ratio at T-points162 CALL bn2 ( ts(:,:,:,:,Kmm), rab_n, rn2 )! before Brunt-Vaisala frequency need for zdfmxl161 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points 162 CALL bn2 ( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm ) ! before Brunt-Vaisala frequency need for zdfmxl 163 163 164 164 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl … … 785 785 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 786 786 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) 787 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points788 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala787 CALL eos_rab( pts, rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points 788 CALL bn2 ( pts, rab_n, rn2, Kmm ) ! now Brunt-Vaisala 789 789 790 790 ! Partial steps: before Horizontal DErivative 791 791 IF( ln_zps .AND. .NOT. ln_isfcav) & 792 & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient792 & CALL zps_hde ( kt, Kmm, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 793 793 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 794 794 IF( ln_zps .AND. ln_isfcav) & 795 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF)795 & CALL zps_hde_isf( kt, Kmm, jpts, pts, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 796 796 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 797 797 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcadv.F90
r10946 r10954 118 118 & CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC', Kmm, Krhs ) ! add the eiv transport 119 119 ! 120 IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport120 IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC', Kmm ) ! add the mle transport 121 121 ! 122 122 ENDIF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcbbl.F90
r10946 r10954 36 36 CONTAINS 37 37 38 SUBROUTINE trc_bbl( kt, K mm, Krhs )38 SUBROUTINE trc_bbl( kt, Kbb, Kmm, Krhs ) 39 39 !!---------------------------------------------------------------------- 40 40 !! *** ROUTINE bbl *** … … 46 46 !!---------------------------------------------------------------------- 47 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 48 INTEGER, INTENT( in ) :: K mm, Krhs ! time level indices48 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 49 49 INTEGER :: jn ! loop index 50 50 CHARACTER (len=22) :: charout … … 55 55 ! 56 56 IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN 57 CALL bbl( kt, nittrc000, 'TRC' )! Online coupling with dynamics : Computation of bbl coef and bbl transport58 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files57 CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport 58 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 59 59 ENDIF 60 60 … … 67 67 IF( nn_bbl_ldf == 1 ) THEN 68 68 ! 69 CALL tra_bbl_dif( trb, tra, jptra )69 CALL tra_bbl_dif( trb, tra, jptra, Kmm ) 70 70 IF( ln_ctl ) THEN 71 71 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_trc_info(charout) … … 78 78 IF( nn_bbl_adv /= 0 ) THEN 79 79 ! 80 CALL tra_bbl_adv( trb, tra, jptra )80 CALL tra_bbl_adv( trb, tra, jptra, Kmm ) 81 81 IF( ln_ctl ) THEN 82 82 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_trc_info(charout) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcldf.F90
r10946 r10954 94 94 ! 95 95 CASE ( np_lap ) ! iso-level laplacian 96 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 )96 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 , Kmm ) 97 97 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 98 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 )98 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 , Kmm ) 99 99 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 100 100 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 , Kmm ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcnxt.F90
r10946 r10954 54 54 CONTAINS 55 55 56 SUBROUTINE trc_nxt( kt, K mm, Krhs )56 SUBROUTINE trc_nxt( kt, Kbb, Kmm, Krhs ) 57 57 !!---------------------------------------------------------------------- 58 58 !! *** ROUTINE trcnxt *** … … 79 79 !!---------------------------------------------------------------------- 80 80 INTEGER, INTENT( in ) :: kt ! ocean time-step index 81 INTEGER, INTENT( in ) :: K mm, Krhs ! time level indices81 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 82 82 ! 83 83 INTEGER :: jk, jn ! dummy loop indices … … 157 157 ELSE 158 158 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 159 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh160 ELSE ; CALL tra_nxt_vvl( kt, K mm, Krhs, nittrc000, rdttrc, 'TRC', trb, trn, tra, &161 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh159 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, Kmm, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh 160 ELSE ; CALL tra_nxt_vvl( kt, Kbb, Kmm, Krhs, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 161 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 162 162 ENDIF 163 163 ELSE -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trctrp.F90
r10946 r10954 62 62 ! 63 63 CALL trc_sbc ( kt, Kmm, Krhs ) ! surface boundary condition 64 IF( ln_trabbl ) CALL trc_bbl ( kt, K mm, Krhs )! advective (and/or diffusive) bottom boundary layer scheme64 IF( ln_trabbl ) CALL trc_bbl ( kt, Kbb, Kmm, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme 65 65 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kmm, Krhs ) ! internal damping trends 66 66 IF( ln_bdy ) CALL trc_bdy_dmp( kt ) ! BDY damping trends … … 68 68 ! ! Partial top/bottom cell: GRADh( trb ) 69 69 IF( ln_zps ) THEN 70 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom71 ELSE ; CALL zps_hde ( kt, jptra, trb, gtru, gtrv ) ! only bottom70 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 71 ELSE ; CALL zps_hde ( kt, Kmm, jptra, trb, gtru, gtrv ) ! only bottom 72 72 ENDIF 73 73 ENDIF … … 78 78 #endif 79 79 CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 80 CALL trc_nxt ( kt, K mm, Krhs ) ! tracer fields at next time step80 CALL trc_nxt ( kt, Kbb, Kmm, Krhs ) ! tracer fields at next time step 81 81 IF( ln_trcrad ) CALL trc_rad ( kt, Kmm, Krhs ) ! Correct artificial negative concentrations 82 82 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt ) ! internal damping trends on closed seas only … … 87 87 IF( ln_trcdmp ) CALL trc_dmp( kt, Kmm, Krhs ) ! internal damping trends 88 88 CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 89 CALL trc_nxt( kt, K mm, Krhs )! tracer fields at next time step89 CALL trc_nxt( kt, Kbb, Kmm, Krhs ) ! tracer fields at next time step 90 90 IF( ln_trcrad ) CALL trc_rad( kt, Kmm, Krhs ) ! Correct artificial negative concentrations 91 91 !
Note: See TracChangeset
for help on using the changeset viewer.
