- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/ZDF/zdfddm.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/ZDF/zdfddm.F90
r10068 r13463 30 30 31 31 !! * Substitutions 32 # include " vectopt_loop_substitute.h90"32 # include "do_loop_substitute.h90" 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 38 38 CONTAINS 39 39 40 SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs )40 SUBROUTINE zdf_ddm( kt, Kmm, p_avm, p_avt, p_avs ) 41 41 !!---------------------------------------------------------------------- 42 42 !! *** ROUTINE zdf_ddm *** … … 68 68 !! References : Merryfield et al., JPO, 29, 1124-1142, 1999. 69 69 !!---------------------------------------------------------------------- 70 INTEGER, INTENT(in ) :: kt ! ocean time-step indexocean time step 70 INTEGER, INTENT(in ) :: kt ! ocean time-step index 71 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 71 72 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! Kz on momentum (w-points) 72 73 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! Kz on temperature (w-points) … … 76 77 REAL(wp) :: zaw, zbw, zrw ! local scalars 77 78 REAL(wp) :: zdt, zds 78 REAL(wp) :: zinr, zrr ! - - 79 REAL(wp) :: zavft, zavfs ! - - 79 REAL(wp) :: zinr ! - - 80 REAL(dp) :: zrr ! - - 81 REAL(wp) :: zavft ! - - 82 REAL(dp) :: zavfs ! - - 80 83 REAL(wp) :: zavdt, zavds ! - - 81 84 REAL(wp), DIMENSION(jpi,jpj) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 … … 91 94 !!gm and many acces in memory 92 95 93 DO jj = 1, jpj !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 94 DO ji = 1, jpi 95 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 96 !!gm please, use e3w_n below 97 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 98 ! 99 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) & 100 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 101 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) & 102 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 103 ! 104 zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 105 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 106 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 107 zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau 108 END DO 109 END DO 96 DO_2D( 1, 1, 1, 1 ) 97 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 98 !!gm please, use e3w at Kmm below 99 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 100 ! 101 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) & 102 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 103 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) & 104 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 105 ! 106 zdt = zaw * ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) 107 zds = zbw * ( ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) 108 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 109 zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau 110 END_2D 110 111 111 DO jj = 1, jpj !== indicators ==! 112 DO ji = 1, jpi 113 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 114 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp 115 ELSE ; zmsks(ji,jj) = 1._wp 116 ENDIF 117 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 118 IF( zrau(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 119 ELSE ; zmskf(ji,jj) = 1._wp 120 ENDIF 121 ! diffusive layering indicators: 122 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 123 IF( zrau(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 124 ELSE ; zmskd1(ji,jj) = 1._wp 125 ENDIF 126 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 127 IF( zrau(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 128 ELSE ; zmskd2(ji,jj) = 1._wp 129 ENDIF 130 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 131 IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 132 ELSE ; zmskd3(ji,jj) = 1._wp 133 ENDIF 134 END DO 135 END DO 112 DO_2D( 1, 1, 1, 1 ) 113 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 114 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp 115 ELSE ; zmsks(ji,jj) = 1._wp 116 ENDIF 117 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 118 IF( zrau(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 119 ELSE ; zmskf(ji,jj) = 1._wp 120 ENDIF 121 ! diffusive layering indicators: 122 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 123 IF( zrau(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 124 ELSE ; zmskd1(ji,jj) = 1._wp 125 ENDIF 126 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 127 IF( zrau(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 128 ELSE ; zmskd2(ji,jj) = 1._wp 129 ENDIF 130 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 131 IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 132 ELSE ; zmskd3(ji,jj) = 1._wp 133 ENDIF 134 END_2D 136 135 ! mask zmsk in order to have avt and avs masked 137 136 zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) … … 141 140 ! ------------------ 142 141 ! Constant eddy coefficient: reset to the background value 143 DO jj = 1, jpj 144 DO ji = 1, jpi 145 zinr = 1._wp / zrau(ji,jj) 146 ! salt fingering 147 zrr = zrau(ji,jj) / rn_hsbfr 148 zrr = zrr * zrr 149 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 150 zavft = 0.7 * zavfs * zinr 151 ! diffusive layering 152 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 153 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 154 & + 0.15 * zrau(ji,jj) * zmskd2(ji,jj) ) 155 ! add to the eddy viscosity coef. previously computed 156 p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 157 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 158 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 159 END DO 160 END DO 142 DO_2D( 1, 1, 1, 1 ) 143 zinr = 1._wp / zrau(ji,jj) 144 ! salt fingering 145 zrr = zrau(ji,jj) / rn_hsbfr 146 zrr = zrr * zrr 147 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 148 zavft = 0.7 * zavfs * zinr 149 ! diffusive layering 150 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 151 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 152 & + 0.15 * zrau(ji,jj) * zmskd2(ji,jj) ) 153 ! add to the eddy viscosity coef. previously computed 154 p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 155 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 156 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 157 END_2D 161 158 ! ! =============== 162 159 END DO ! End of slab 163 160 ! ! =============== 164 161 ! 165 IF( ln_ctl) THEN162 IF(sn_cfctl%l_prtctl) THEN 166 163 CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm - t: ', tab3d_2=avs , clinfo2=' s: ', kdim=jpk) 167 164 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
