Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90
- Timestamp:
- 2021-11-26T12:27:56+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90
r14986 r15540 64 64 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 65 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 66 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM)66 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 67 67 68 68 !! * Substitutions … … 108 108 ! 109 109 INTEGER :: ji, jj, jk ! Dummy loop indices 110 REAL( wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds110 REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 111 111 !!---------------------------------------------------------------------- 112 112 ! … … 123 123 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 124 124 ! 125 CALL tra_bbl_dif( CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts, Kmm )125 CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 126 126 IF( sn_cfctl%l_prtctl ) & 127 CALL prt_ctl( tab3d_1= CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, &128 & tab3d_2= CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )127 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 128 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 129 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 130 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef … … 134 134 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 135 135 ! 136 CALL tra_bbl_adv( CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts, Kmm )136 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 137 137 IF(sn_cfctl%l_prtctl) & 138 CALL prt_ctl( tab3d_1= CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_adv - Ta: ', mask1=tmask, &139 & tab3d_2= CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )138 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 139 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 140 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 141 141 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport … … 178 178 !!---------------------------------------------------------------------- 179 179 INTEGER , INTENT(in ) :: kjpt ! number of tracers 180 REAL( wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields180 REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 181 181 REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 182 182 INTEGER , INTENT(in ) :: Kmm ! time level indices … … 184 184 INTEGER :: ji, jj, jn ! dummy loop indices 185 185 INTEGER :: ik ! local integers 186 REAL( wp) :: zbtr ! local scalars186 REAL(dp) :: zbtr ! local scalars 187 187 REAL(wp), DIMENSION(A2D(nn_hls)) :: zptb ! workspace 188 188 !!---------------------------------------------------------------------- … … 227 227 !!---------------------------------------------------------------------- 228 228 INTEGER , INTENT(in ) :: kjpt ! number of tracers 229 REAL( wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields229 REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 230 230 REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 231 231 INTEGER , INTENT(in ) :: Kmm ! time level indices … … 234 234 INTEGER :: iis , iid , ijs , ijd ! local integers 235 235 INTEGER :: ikus, ikud, ikvs, ikvd ! - - 236 REAL( wp) :: zbtr, ztra ! local scalars237 REAL( wp) :: zu_bbl, zv_bbl ! - -236 REAL(dp) :: zbtr, ztra ! local scalars 237 REAL(dp) :: zu_bbl, zv_bbl ! - - 238 238 !!---------------------------------------------------------------------- 239 239 ! ! =========== … … 328 328 REAL(wp) :: za, zb, zgdrho ! local scalars 329 329 REAL(wp) :: zsign, zsigna, zgbbl ! - - 330 REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zts, zab ! 3D workspace 330 REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zts! 3D workspace 331 REAL(dp), DIMENSION(A2D(nn_hls),jpts) :: zab! 3D workspace 331 332 REAL(wp), DIMENSION(A2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace 332 333 !!---------------------------------------------------------------------- … … 350 351 END_2D 351 352 ! 352 CALL eos_rab( zts, zdep, zab, Kmm )353 CALL eos_rab( CASTDP(zts), CASTDP(zdep), zab, Kmm ) 353 354 ! 354 355 ! !-------------------! … … 363 364 & - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 364 365 ! 365 zsign = SIGN( 0.5_wp, CASTWP(-zgdrho * REAL( mgrhu(ji,jj))) ) ! sign of ( i-gradient * i-slope )366 zsign = SIGN( 0.5_wp, -zgdrho * REAL( mgrhu(ji,jj)) ) ! sign of ( i-gradient * i-slope ) 366 367 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 367 368 ! … … 373 374 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 374 375 ! 375 zsign = SIGN( 0.5_wp, CASTWP(-zgdrho * REAL( mgrhv(ji,jj))) ) ! sign of ( j-gradient * j-slope )376 zsign = SIGN( 0.5_wp, -zgdrho * REAL( mgrhv(ji,jj)) ) ! sign of ( j-gradient * j-slope ) 376 377 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 377 378 END_2D … … 393 394 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 394 395 ! 395 zsign = SIGN( 0.5_wp, CASTWP(- zgdrho * REAL( mgrhu(ji,jj))) ) ! sign of i-gradient * i-slope396 zsigna= SIGN( 0.5_wp, CASTWP(zub(ji,jj) * REAL( mgrhu(ji,jj))) ) ! sign of u * i-slope396 zsign = SIGN( 0.5_wp, - zgdrho * REAL( mgrhu(ji,jj)) ) ! sign of i-gradient * i-slope 397 zsigna= SIGN( 0.5_wp, zub(ji,jj) * REAL( mgrhu(ji,jj)) ) ! sign of u * i-slope 397 398 ! 398 399 ! ! bbl velocity … … 405 406 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 406 407 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 407 zsign = SIGN( 0.5_wp, CASTWP(- zgdrho * REAL( mgrhv(ji,jj))) ) ! sign of j-gradient * j-slope408 zsigna= SIGN( 0.5_wp, CASTWP(zvb(ji,jj) * REAL( mgrhv(ji,jj))) ) ! sign of u * i-slope408 zsign = SIGN( 0.5_wp, - zgdrho * REAL( mgrhv(ji,jj)) ) ! sign of j-gradient * j-slope 409 zsigna= SIGN( 0.5_wp, zvb(ji,jj) * REAL( mgrhv(ji,jj)) ) ! sign of u * i-slope 409 410 ! 410 411 ! ! bbl transport … … 469 470 INTEGER :: ji, jj ! dummy loop indices 470 471 INTEGER :: ii0, ii1, ij0, ij1, ios ! local integer 471 REAL( wp), DIMENSION(jpi,jpj) :: zmbku, zmbkv ! workspace472 REAL(dp), DIMENSION(jpi,jpj) :: zmbku, zmbkv ! workspace 472 473 !! 473 474 NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
Note: See TracChangeset
for help on using the changeset viewer.
