Changeset 10985 for NEMO/branches/2019
- Timestamp:
- 2019-05-15T21:19:35+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbc.F90
r10954 r10985 51 51 CONTAINS 52 52 53 SUBROUTINE tra_bbc( kt, Kmm, Krhs )53 SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_bbc *** … … 73 73 !! Emile-Geay and Madec, 2009, Ocean Science. 74 74 !!---------------------------------------------------------------------- 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 76 INTEGER, INTENT(in) :: Kmm, Krhs ! time level indices 75 INTEGER, INTENT(in ) :: kt ! ocean time-step index 76 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 77 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 77 78 ! 78 79 INTEGER :: ji, jj ! dummy loop indices … … 84 85 IF( l_trdtra ) THEN ! Save the input temperature trend 85 86 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 86 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)87 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 87 88 ENDIF 88 89 ! ! Add the geothermal trend on temperature 89 90 DO jj = 2, jpjm1 90 91 DO ji = 2, jpim1 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 pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm) 92 93 END DO 93 94 END DO 94 95 ! 95 CALL lbc_lnk( 'trabbc', ts(:,:,:,jp_tem,Krhs) , 'T', 1. )96 CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. ) 96 97 ! 97 98 IF( l_trdtra ) THEN ! Send the trend for diagnostics 98 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)99 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 99 100 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 100 101 DEALLOCATE( ztrdt ) 101 102 ENDIF 102 103 ! 103 IF(ln_ctl) CALL prt_ctl( tab3d_1= ts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' )104 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 104 105 ! 105 106 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
r10954 r10985 89 89 90 90 91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs )91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, pts, Krhs ) 92 92 !!---------------------------------------------------------------------- 93 93 !! *** ROUTINE bbl *** … … 101 101 !! is added to the general tracer trend 102 102 !!---------------------------------------------------------------------- 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 103 INTEGER, INTENT(in ) :: kt ! ocean time-step 104 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 105 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 105 106 ! 106 107 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 111 112 IF( l_trdtra ) THEN !* Save the T-S input trends 112 113 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 113 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)114 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs)114 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 115 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 115 116 ENDIF 116 117 … … 119 120 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 120 121 ! 121 CALL tra_bbl_dif( ts(:,:,:,:,Kbb),ts(:,:,:,:,Krhs), jpts, Kmm )122 CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 122 123 IF( ln_ctl ) & 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' )124 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 125 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 126 ! lateral boundary conditions ; just need for outputs 126 127 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) … … 132 133 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 133 134 ! 134 CALL tra_bbl_adv( ts(:,:,:,:,Kbb),ts(:,:,:,:,Krhs), jpts, Kmm )135 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 135 136 IF(ln_ctl) & 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' )137 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 138 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 138 139 ! lateral boundary conditions ; just need for outputs 139 140 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) … … 144 145 145 146 IF( l_trdtra ) THEN ! send the trends for further diagnostics 146 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)147 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)147 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 148 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 148 149 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 149 150 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 156 157 157 158 158 SUBROUTINE tra_bbl_dif( pt b, pta, kjpt, Kmm )159 SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm ) 159 160 !!---------------------------------------------------------------------- 160 161 !! *** ROUTINE tra_bbl_dif *** … … 172 173 !! convection is satified) 173 174 !! 174 !! ** Action : pt aincreased by the bbl diffusive trend175 !! ** Action : pt_rhs increased by the bbl diffusive trend 175 176 !! 176 177 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. … … 178 179 !!---------------------------------------------------------------------- 179 180 INTEGER , INTENT(in ) :: kjpt ! number of tracers 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before and now tracer fields181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 182 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 182 183 INTEGER , INTENT(in ) :: Kmm ! time level indices 183 184 ! … … 193 194 DO ji = 1, jpi 194 195 ik = mbkt(ji,jj) ! bottom T-level index 195 zptb(ji,jj) = pt b(ji,jj,ik,jn)! bottom before T and S196 zptb(ji,jj) = pt(ji,jj,ik,jn) ! bottom before T and S 196 197 END DO 197 198 END DO … … 200 201 DO ji = 2, jpim1 201 202 ik = mbkt(ji,jj) ! bottom T-level index 202 pt a(ji,jj,ik,jn) = pta(ji,jj,ik,jn) &203 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) &204 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) &205 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) &206 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) &207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)203 pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn) & 204 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 205 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 206 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 207 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 208 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 208 209 END DO 209 210 END DO … … 214 215 215 216 216 SUBROUTINE tra_bbl_adv( pt b, pta, kjpt, Kmm )217 SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 217 218 !!---------------------------------------------------------------------- 218 219 !! *** ROUTINE trc_bbl *** … … 230 231 !!---------------------------------------------------------------------- 231 232 INTEGER , INTENT(in ) :: kjpt ! number of tracers 232 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before and now tracer fields233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 234 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 234 235 INTEGER , INTENT(in ) :: Kmm ! time level indices 235 236 ! … … 254 255 ! ! up -slope T-point (shelf bottom point) 255 256 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 256 ztra = zu_bbl * ( pt b(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr257 pt a(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra257 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 258 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 258 259 ! 259 260 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 260 261 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 261 ztra = zu_bbl * ( pt b(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr262 pt a(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra262 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 263 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 263 264 END DO 264 265 ! 265 266 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 266 ztra = zu_bbl * ( pt b(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr267 pt a(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra267 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 268 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 268 269 ENDIF 269 270 ! … … 276 277 ! up -slope T-point (shelf bottom point) 277 278 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 278 ztra = zv_bbl * ( pt b(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr279 pt a(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra279 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 280 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 280 281 ! 281 282 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 282 283 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 283 ztra = zv_bbl * ( pt b(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr284 pt a(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra284 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 285 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 285 286 END DO 286 287 ! ! down-slope T-point (deep bottom point) 287 288 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 288 ztra = zv_bbl * ( pt b(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr289 pt a(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra289 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 290 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 290 291 ENDIF 291 292 END DO … … 348 349 DO ji = 1, jpi 349 350 ik = mbkt(ji,jj) ! bottom T-level index 350 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) 351 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 351 352 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 352 353 ! 353 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) 354 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) 354 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) ! bottom T-level reference depth 355 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) ! bottom velocity 355 356 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 356 357 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90
r10954 r10985 72 72 73 73 74 SUBROUTINE tra_dmp( kt, Kbb, Kmm, Krhs )74 SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs ) 75 75 !!---------------------------------------------------------------------- 76 76 !! *** ROUTINE tra_dmp *** … … 90 90 !! ** Action : - tsa: tracer trends updated with the damping trend 91 91 !!---------------------------------------------------------------------- 92 INTEGER, INTENT(in) :: kt ! ocean time-step index 93 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 92 INTEGER, INTENT(in ) :: kt ! ocean time-step index 93 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 94 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 94 95 ! 95 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 102 103 IF( l_trdtra ) THEN !* Save ta and sa trends 103 104 ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 104 ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs)105 ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 105 106 ENDIF 106 107 ! !== input T-S data at kt ==! … … 114 115 DO jj = 2, jpjm1 115 116 DO ji = fs_2, fs_jpim1 ! vector opt. 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 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 118 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 119 END DO 118 120 END DO … … 125 127 DO ji = fs_2, fs_jpim1 ! vector opt. 126 128 IF( avt(ji,jj,jk) <= avt_c ) THEN 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) )129 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 131 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 132 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 131 133 ENDIF 132 134 END DO … … 139 141 DO ji = fs_2, fs_jpim1 ! vector opt. 140 142 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) )143 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 145 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 146 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 145 147 ENDIF 146 148 END DO … … 151 153 ! 152 154 IF( l_trdtra ) THEN ! trend diagnostic 153 ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs) - ztrdts(:,:,:,:)155 ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 154 156 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 155 157 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) … … 157 159 ENDIF 158 160 ! ! Control print 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 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, & 162 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 163 ! 162 164 IF( ln_timing ) CALL timing_stop('tra_dmp') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranpc.F90
r10954 r10985 42 42 CONTAINS 43 43 44 SUBROUTINE tra_npc( kt, Kmm, Krhs )44 SUBROUTINE tra_npc( kt, Kmm, Krhs, pts, Kaa ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE tranpc *** … … 58 58 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 61 INTEGER, INTENT(in) :: Kmm, Krhs ! time level indices 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm, Krhs, Kaa ! time level indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 62 63 ! 63 64 INTEGER :: ji, jj, jk ! dummy loop indices … … 67 68 REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 68 69 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 69 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0)70 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point...71 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point72 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^273 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta74 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 70 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 71 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... 72 REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point 73 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 74 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 75 76 ! 76 77 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 85 86 IF( l_trdtra ) THEN !* Save initial after fields 86 87 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 87 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)88 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs)88 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa) 89 ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa) 89 90 ENDIF 90 91 ! … … 96 97 ENDIF 97 98 ! 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)99 CALL eos_rab( pts(:,:,:,:,Kaa), zab, Kmm ) ! after alpha and beta (given on T-points) 100 CALL bn2 ( pts(:,:,:,:,Kaa), zab, zn2, Kmm ) ! after Brunt-Vaisala (given on W-points) 100 101 ! 101 102 inpcc = 0 … … 106 107 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points 107 108 ! ! consider one ocean column 108 zvts(:,jp_tem) = ts(ji,jj,:,jp_tem,Krhs) ! temperature109 zvts(:,jp_sal) = ts(ji,jj,:,jp_sal,Krhs) ! salinity109 zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa) ! temperature 110 zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa) ! salinity 110 111 ! 111 112 zvab(:,jp_tem) = zab(ji,jj,:,jp_tem) ! Alpha … … 287 288 END DO ! DO WHILE ( .NOT. l_column_treated ) 288 289 289 !! Updating tsa:290 ts(ji,jj,:,jp_tem,Krhs) = zvts(:,jp_tem)291 ts(ji,jj,:,jp_sal,Krhs) = zvts(:,jp_sal)290 !! Updating pts: 291 pts(ji,jj,:,jp_tem,Kaa) = zvts(:,jp_tem) 292 pts(ji,jj,:,jp_sal,Kaa) = zvts(:,jp_sal) 292 293 293 294 !! LB: Potentially some other global variable beside theta and S can be treated here … … 303 304 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 304 305 z1_r2dt = 1._wp / (2._wp * rdt) 305 ztrdt(:,:,:) = ( ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) ) * z1_r2dt306 ztrds(:,:,:) = ( ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) ) * z1_r2dt306 ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_r2dt 307 ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_r2dt 307 308 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 308 309 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) … … 310 311 ENDIF 311 312 ! 312 CALL lbc_lnk_multi( 'tranpc', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. )313 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 313 314 ! 314 315 IF( lwp .AND. l_LB_debug ) THEN -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traqsr.F90
r10954 r10985 75 75 CONTAINS 76 76 77 SUBROUTINE tra_qsr( kt, Kmm, Krhs )77 SUBROUTINE tra_qsr( kt, Kmm, pts, Krhs ) 78 78 !!---------------------------------------------------------------------- 79 79 !! *** ROUTINE tra_qsr *** … … 101 101 !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562 102 102 !!---------------------------------------------------------------------- 103 INTEGER, INTENT(in) :: kt ! ocean time-step 104 INTEGER, INTENT(in) :: Kmm, Krhs ! time level indices 103 INTEGER, INTENT(in ) :: kt ! ocean time-step 104 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 105 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 105 106 ! 106 107 INTEGER :: ji, jj, jk ! dummy loop indices … … 127 128 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 128 129 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 129 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)130 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 130 131 ENDIF 131 132 ! … … 262 263 DO jj = 2, jpjm1 !-----------------------------! 263 264 DO ji = fs_2, fs_jpim1 ! vector opt. 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)265 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 266 & + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 266 267 END DO 267 268 END DO … … 296 297 ! 297 298 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 298 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)299 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 299 300 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 300 301 DEALLOCATE( ztrdt ) 301 302 ENDIF 302 303 ! ! print mean trends (used for debugging) 303 IF(ln_ctl) CALL prt_ctl( tab3d_1= ts(:,:,:,jp_tem,Krhs), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' )304 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 304 305 ! 305 306 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
r10954 r10985 51 51 CONTAINS 52 52 53 SUBROUTINE tra_sbc ( kt, Kmm, Krhs )53 SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_sbc *** … … 72 72 !! - send trends to trdtra module for further diagnostics(l_trdtra=T) 73 73 !!---------------------------------------------------------------------- 74 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 INTEGER, INTENT(in) :: Kmm, Krhs ! time level indices 74 INTEGER, INTENT(in ) :: kt ! ocean time-step index 75 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 76 77 ! 77 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 91 92 IF( l_trdtra ) THEN !* Save ta and sa trends 92 93 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 93 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)94 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs)94 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 95 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 95 96 ENDIF 96 97 ! … … 132 133 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 133 134 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(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)135 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 136 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 136 137 END DO 137 138 END DO !==>> output c./d. term 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) )139 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 140 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 140 141 ENDIF 141 142 ! … … 143 144 DO jj = 2, jpj 144 145 DO ji = fs_2, fs_jpim1 ! vector opt. 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 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) 146 147 END DO 147 148 END DO … … 174 175 DO jk = ikt, ikb - 1 175 176 ! compute trend 176 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)&177 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )&178 & * r1_hisf_tbl(ji,jj)177 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 178 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) & 179 & * r1_hisf_tbl(ji,jj) 179 180 END DO 180 181 181 182 ! level partially include in ice shelf boundary layer 182 183 ! compute trend 183 ts(ji,jj,ikb,jp_tem,Krhs) = ts(ji,jj,ikb,jp_tem,Krhs)&184 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )&185 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)184 pts(ji,jj,ikb,jp_tem,Krhs) = pts(ji,jj,ikb,jp_tem,Krhs) & 185 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) & 186 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 186 187 187 188 END DO … … 200 201 zdep = zfact / h_rnf(ji,jj) 201 202 DO jk = 1, nk_rnf(ji,jj) 202 ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)&203 & + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep204 IF( ln_rnf_sal ) ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs)&205 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep203 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 204 & + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 205 IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 206 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 206 207 END DO 207 208 ENDIF … … 210 211 ENDIF 211 212 212 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf* ts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst213 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf* ts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss213 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 214 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 214 215 215 216 #if defined key_asminc … … 225 226 DO ji = fs_2, fs_jpim1 226 227 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) * ztim228 ts(ji,jj,1,jp_sal,Krhs) = ts(ji,jj,1,jp_sal,Krhs) +ts(ji,jj,1,jp_sal,Kmm) * ztim228 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim 229 pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim 229 230 END DO 230 231 END DO … … 233 234 DO ji = fs_2, fs_jpim1 234 235 ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) ) 235 ts(ji,jj,:,jp_tem,Krhs) = ts(ji,jj,:,jp_tem,Krhs) +ts(ji,jj,:,jp_tem,Kmm) * ztim236 ts(ji,jj,:,jp_sal,Krhs) = ts(ji,jj,:,jp_sal,Krhs) +ts(ji,jj,:,jp_sal,Kmm) * ztim236 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim 237 pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim 237 238 END DO 238 239 END DO … … 252 253 DO ji = fs_2, fs_jpim1 253 254 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) * zdep255 ts(ji,jj,jk,jp_sal,Krhs) =ts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep255 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep 256 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep 256 257 END DO 257 258 END DO … … 260 261 261 262 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 262 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)263 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)263 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 264 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 264 265 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 265 266 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) … … 267 268 ENDIF 268 269 ! 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' )270 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, & 271 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 271 272 ! 272 273 IF( ln_timing ) CALL timing_stop('tra_sbc') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90
r10980 r10985 242 242 IF( lk_asminc .AND. ln_asmiau .AND. & 243 243 & ln_trainc ) CALL tra_asm_inc ( kstp, Nbb, Nnn, ts, Nrhs ) ! apply tracer assimilation increment 244 CALL tra_sbc ( kstp, Nnn, Nrhs ) ! surface boundary condition245 IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, Nrhs ) ! penetrative solar radiation qsr246 IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, Nrhs ) ! bottom heat flux247 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme248 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, Nrhs ) ! internal damping trends249 IF( ln_bdy ) CALL bdy_tra_dmp ( kstp, Nbb, ts, Nrhs ) ! bdy damping trends244 CALL tra_sbc ( kstp, Nnn, ts, Nrhs ) ! surface boundary condition 245 IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, ts, Nrhs ) ! penetrative solar radiation qsr 246 IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, ts, Nrhs ) ! bottom heat flux 247 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, ts, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme 248 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, ts, Nrhs ) ! internal damping trends 249 IF( ln_bdy ) CALL bdy_tra_dmp ( kstp, Nbb, ts, Nrhs ) ! bdy damping trends 250 250 #if defined key_agrif 251 251 IF(.NOT. Agrif_Root()) & … … 262 262 !!gm 263 263 CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vert. mixing & after tracer ==> after 264 IF( ln_zdfnpc ) CALL tra_npc( kstp, Nnn, Nrhs 264 IF( ln_zdfnpc ) CALL tra_npc( kstp, Nnn, Nrhs, ts, Naa ) ! update after fields by non-penetrative convection 265 265 266 266 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcbbl.F90
r10966 r10985 20 20 !! trc_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 21 21 !!---------------------------------------------------------------------- 22 USE oce_trc ! ocean dynamics and active tracers variables22 USE oce_trc ! ocean dynamics and passive tracers variables 23 23 USE trc ! ocean passive tracers variables 24 24 USE trd_oce ! trends: ocean variables … … 36 36 CONTAINS 37 37 38 SUBROUTINE trc_bbl( kt, Kbb, Kmm, Krhs )38 SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs ) 39 39 !!---------------------------------------------------------------------- 40 40 !! *** ROUTINE bbl *** … … 45 45 !! 46 46 !!---------------------------------------------------------------------- 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 48 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 47 INTEGER, INTENT( in ) :: kt ! ocean time-step 48 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 49 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 49 50 INTEGER :: jn ! loop index 50 51 CHARACTER (len=22) :: charout … … 61 62 IF( l_trdtrc ) THEN 62 63 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 63 ztrtrd(:,:,:,:) = tr(:,:,:,:,Krhs)64 ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 64 65 ENDIF 65 66 … … 67 68 IF( nn_bbl_ldf == 1 ) THEN 68 69 ! 69 CALL tra_bbl_dif( tr(:,:,:,:,Kbb),tr(:,:,:,:,Krhs), jptra, Kmm )70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 70 71 IF( ln_ctl ) THEN 71 72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_trc_info(charout) 72 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )73 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 73 74 ENDIF 74 75 ! … … 78 79 IF( nn_bbl_adv /= 0 ) THEN 79 80 ! 80 CALL tra_bbl_adv( tr(:,:,:,:,Kbb),tr(:,:,:,:,Krhs), jptra, Kmm )81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 81 82 IF( ln_ctl ) THEN 82 83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_trc_info(charout) 83 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )84 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 84 85 ENDIF 85 86 ! … … 88 89 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 89 90 DO jn = 1, jptra 90 ztrtrd(:,:,:,jn) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn)91 ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 91 92 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 92 93 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcdmp.F90
r10966 r10985 63 63 64 64 65 SUBROUTINE trc_dmp( kt, Kbb, Kmm, Krhs )65 SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 66 66 !!---------------------------------------------------------------------- 67 67 !! *** ROUTINE trc_dmp *** … … 82 82 !! - save the trends ('key_trdmxl_trc') 83 83 !!---------------------------------------------------------------------- 84 INTEGER, INTENT(in) :: kt ! ocean time-step index 85 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 84 INTEGER, INTENT(in ) :: kt ! ocean time-step index 85 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 86 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 86 87 ! 87 88 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices … … 101 102 DO jn = 1, jptra ! tracer loop 102 103 ! ! =========== 103 IF( l_trdtrc ) ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) ! save trends104 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 104 105 ! 105 106 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file … … 114 115 DO jj = 2, jpjm1 115 116 DO ji = fs_2, fs_jpim1 ! vector opt. 116 tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) -tr(ji,jj,jk,jn,Kbb) )117 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 117 118 END DO 118 119 END DO … … 124 125 DO ji = fs_2, fs_jpim1 ! vector opt. 125 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 126 tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) -tr(ji,jj,jk,jn,Kbb) )127 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 127 128 ENDIF 128 129 END DO … … 135 136 DO ji = fs_2, fs_jpim1 ! vector opt. 136 137 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 137 tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) -tr(ji,jj,jk,jn,Kbb) )138 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 138 139 END IF 139 140 END DO … … 146 147 ! 147 148 IF( l_trdtrc ) THEN 148 ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:)149 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 149 150 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 150 151 END IF … … 160 161 WRITE(charout, FMT="('dmp ')") 161 162 CALL prt_ctl_trc_info(charout) 162 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )163 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 163 164 ENDIF 164 165 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcldf.F90
r10980 r10985 51 51 CONTAINS 52 52 53 SUBROUTINE trc_ldf( kt, Kbb, Kmm, Krhs )53 SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_ldf *** … … 58 58 !! 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! ocean time-level index 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time-level index 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 62 63 ! 63 64 INTEGER :: ji, jj, jk, jn 64 65 REAL(wp) :: zdep 65 66 CHARACTER (len=22) :: charout 66 REAL(wp), DIMENSION(jpi,jpj,jpk):: zahu, zahv67 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahu, zahv 68 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 68 69 !!---------------------------------------------------------------------- 69 70 ! … … 74 75 IF( l_trdtrc ) THEN 75 76 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 76 ztrtrd(:,:,:,:) = tr(:,:,:,:,Krhs)77 ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) 77 78 ENDIF 78 79 ! !* set the lateral diffusivity coef. for passive tracer … … 95 96 CASE ( np_lap ) ! iso-level laplacian 96 97 CALL tra_ldf_lap ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 97 & tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs),jptra, 1 )98 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 98 99 CASE ( np_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 99 100 CALL tra_ldf_iso ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 100 & tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb),tr(:,:,:,:,Krhs), jptra, 1 )101 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 101 102 CASE ( np_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 102 103 CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 103 & tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb),tr(:,:,:,:,Krhs), jptra, 1 )104 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 104 105 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 105 106 CALL tra_ldf_blp ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 106 & tr(:,:,:,:,Kbb) ,tr(:,:,:,:,Krhs), jptra, nldf_trc )107 & ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs), jptra, nldf_trc ) 107 108 END SELECT 108 109 ! 109 110 IF( l_trdtrc ) THEN ! send the trends for further diagnostics 110 111 DO jn = 1, jptra 111 ztrtrd(:,:,:,jn) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn)112 ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 112 113 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 113 114 END DO … … 118 119 WRITE(charout, FMT="('ldf ')") 119 120 CALL prt_ctl_trc_info(charout) 120 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )121 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 121 122 ENDIF 122 123 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcrad.F90
r10966 r10985 37 37 CONTAINS 38 38 39 SUBROUTINE trc_rad( kt, Kbb, Kmm, Krhs )39 SUBROUTINE trc_rad( kt, Kbb, Kmm, Krhs, ptr ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** ROUTINE trc_rad *** … … 52 52 !! (the total CFC content is not strictly preserved) 53 53 !!---------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt ! ocean time-step index 55 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 54 INTEGER, INTENT(in ) :: kt ! ocean time-step index 55 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 56 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 56 57 ! 57 58 CHARACTER (len=22) :: charout … … 60 61 IF( ln_timing ) CALL timing_start('trc_rad') 61 62 ! 62 IF( ln_age ) CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb),tr(:,:,:,:,Kmm), jp_age , jp_age ) ! AGE63 IF( ll_cfc ) CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb),tr(:,:,:,:,Kmm), jp_cfc0, jp_cfc1 ) ! CFC model64 IF( ln_c14 ) CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb),tr(:,:,:,:,Kmm), jp_c14 , jp_c14 ) ! C1465 IF( ln_pisces ) CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb),tr(:,:,:,:,Kmm), jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model66 IF( ln_my_trc ) CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb),tr(:,:,:,:,Kmm), jp_myt0, jp_myt1 ) ! MY_TRC model63 IF( ln_age ) CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_age , jp_age ) ! AGE 64 IF( ll_cfc ) CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_cfc0, jp_cfc1 ) ! CFC model 65 IF( ln_c14 ) CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_c14 , jp_c14 ) ! C14 66 IF( ln_pisces ) CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model 67 IF( ln_my_trc ) CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_myt0, jp_myt1 ) ! MY_TRC model 67 68 ! 68 69 IF(ln_ctl) THEN ! print mean trends (used for debugging) 69 70 WRITE(charout, FMT="('rad')") 70 71 CALL prt_ctl_trc_info( charout ) 71 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )72 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 72 73 ENDIF 73 74 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcsbc.F90
r10966 r10985 37 37 CONTAINS 38 38 39 SUBROUTINE trc_sbc ( kt, Kmm, Krhs )39 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** ROUTINE trc_sbc *** … … 58 58 !! 59 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time-step index 61 INTEGER, INTENT(in) :: Kmm, Krhs ! time level indices 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 62 63 ! 63 64 INTEGER :: ji, jj, jn ! dummy loop indices … … 119 120 DO jj = 2, jpj 120 121 DO ji = fs_2, fs_jpim1 ! vector opt. 121 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * tr(ji,jj,1,jn,Kmm)122 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 122 123 END DO 123 124 END DO … … 138 139 ztfx = zftra ! net tracer flux 139 140 ! 140 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * tr(ji,jj,1,jn,Kmm) )141 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * ptr(ji,jj,1,jn,Kmm) ) 141 142 IF ( zdtra < 0. ) THEN 142 zratio = -zdtra * zse3t * r2dttrc / ( tr(ji,jj,1,jn,Kmm) + zrtrn )143 zratio = -zdtra * zse3t * r2dttrc / ( ptr(ji,jj,1,jn,Kmm) + zrtrn ) 143 144 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 144 145 ENDIF … … 153 154 DO jn = 1, jptra 154 155 ! 155 IF( l_trdtrc ) ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) ! save trends156 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 156 157 ! 157 158 DO jj = 2, jpj 158 159 DO ji = fs_2, fs_jpim1 ! vector opt. 159 160 zse3t = zfact / e3t(ji,jj,1,Kmm) 160 tr(ji,jj,1,jn,Krhs) =tr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t161 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 161 162 END DO 162 163 END DO 163 164 ! 164 165 IF( l_trdtrc ) THEN 165 ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:)166 ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 166 167 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 167 168 END IF … … 184 185 IF( ln_ctl ) THEN 185 186 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) 186 CALL prt_ctl_trc( tab4d= tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )187 CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 187 188 ENDIF 188 189 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) … … 197 198 !!---------------------------------------------------------------------- 198 199 CONTAINS 199 SUBROUTINE trc_sbc (kt) ! Empty routine 200 INTEGER, INTENT(in) :: kt 200 SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) ! Empty routine 201 INTEGER, INTENT(in ) :: kt ! ocean time-step index 202 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 203 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 201 204 WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 202 205 END SUBROUTINE trc_sbc -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trctrp.F90
r10966 r10985 61 61 IF( .NOT. lk_c1d ) THEN 62 62 ! 63 CALL trc_sbc ( kt, Kmm, Krhs )! surface boundary condition64 IF( ln_trabbl ) CALL trc_bbl ( kt, Kbb, Kmm, Krhs )! advective (and/or diffusive) bottom boundary layer scheme65 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kbb, Kmm, Krhs )! internal damping trends63 CALL trc_sbc ( kt, Kmm, tr, Krhs ) ! surface boundary condition 64 IF( ln_trabbl ) CALL trc_bbl ( kt, Kbb, Kmm, tr, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme 65 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends 66 66 IF( ln_bdy ) CALL trc_bdy_dmp( kt, Kbb, Krhs ) ! BDY damping trends 67 67 CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection … … 73 73 ENDIF 74 74 ! 75 CALL trc_ldf ( kt, Kbb, Kmm, Krhs )! lateral mixing75 CALL trc_ldf ( kt, Kbb, Kmm, tr, Krhs ) ! lateral mixing 76 76 #if defined key_agrif 77 77 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge … … 79 79 CALL trc_zdf ( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 80 80 CALL trc_nxt ( kt, Kbb, Kmm, Krhs ) ! tracer fields at next time step 81 IF( ln_trcrad ) CALL trc_rad ( kt, Kbb, Kmm, Krhs )! Correct artificial negative concentrations81 IF( ln_trcrad ) CALL trc_rad ( kt, Kbb, Kmm, Krhs, tr ) ! Correct artificial negative concentrations 82 82 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt, Kbb, Kmm ) ! internal damping trends on closed seas only 83 83 84 84 ! 85 85 ELSE ! 1D vertical configuration 86 CALL trc_sbc( kt, Kmm, Krhs )! surface boundary condition87 IF( ln_trcdmp ) CALL trc_dmp( kt, Kbb, Kmm, Krhs )! internal damping trends86 CALL trc_sbc( kt, Kmm, tr, Krhs ) ! surface boundary condition 87 IF( ln_trcdmp ) CALL trc_dmp( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends 88 88 CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after 89 89 CALL trc_nxt( kt, Kbb, Kmm, Krhs ) ! tracer fields at next time step 90 IF( ln_trcrad ) CALL trc_rad( kt, Kbb, Kmm, Krhs )! Correct artificial negative concentrations90 IF( ln_trcrad ) CALL trc_rad( kt, Kbb, Kmm, Krhs, tr ) ! Correct artificial negative concentrations 91 91 ! 92 92 END IF
Note: See TracChangeset
for help on using the changeset viewer.