Changeset 12119
- Timestamp:
- 2019-12-09T11:55:22+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce.F90
r11769 r12119 65 65 INTEGER, PUBLIC :: scales_t_id 66 66 INTEGER, PUBLIC :: avt_id, avm_id, en_id ! TKE related identificators 67 INTEGER, PUBLIC :: umsk_id, vmsk_id68 67 INTEGER, PUBLIC :: mbkt_id, ht0_id 69 68 INTEGER, PUBLIC :: kindic_agr -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90
r11868 r12119 43 43 PUBLIC interptsn, interpsshn, interpavm 44 44 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 45 PUBLIC interpe3t , interpumsk, interpvmsk45 PUBLIC interpe3t 46 46 #if defined key_vertical 47 47 PUBLIC interpht0, interpmbkt … … 1132 1132 1133 1133 1134 SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before , nb, ndir)1134 SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before ) 1135 1135 !!---------------------------------------------------------------------- 1136 1136 !! *** ROUTINE interpe3t *** … … 1139 1139 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1140 1140 LOGICAL , INTENT(in ) :: before 1141 INTEGER , INTENT(in ) :: nb , ndir1142 1141 ! 1143 1142 INTEGER :: ji, jj, jk 1144 LOGICAL :: western_side, eastern_side, northern_side, southern_side1145 1143 !!---------------------------------------------------------------------- 1146 1144 ! … … 1148 1146 ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 1149 1147 ELSE 1150 western_side = (nb == 1).AND.(ndir == 1)1151 eastern_side = (nb == 1).AND.(ndir == 2)1152 southern_side = (nb == 2).AND.(ndir == 1)1153 northern_side = (nb == 2).AND.(ndir == 2)1154 1148 ! 1155 1149 DO jk = k1, k2 1156 1150 DO jj = j1, j2 1157 1151 DO ji = i1, i2 1158 !1159 1152 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1160 IF (western_side.AND.(ptab(i1+nbghostcells-1,jj,jk)>0._wp)) THEN 1161 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1162 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1163 kindic_agr = kindic_agr + 1 1164 ELSEIF (eastern_side.AND.(ptab(i2-nbghostcells+1,jj,jk)>0._wp)) THEN 1165 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1166 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1167 kindic_agr = kindic_agr + 1 1168 ELSEIF (southern_side.AND.(ptab(ji,j1+nbghostcells-1,jk)>0._wp)) THEN 1169 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1170 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1171 kindic_agr = kindic_agr + 1 1172 ELSEIF (northern_side.AND.(ptab(ji,j2-nbghostcells+1,jk)>0._wp)) THEN 1173 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1174 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1175 kindic_agr = kindic_agr + 1 1176 ENDIF 1153 WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ', & 1154 & ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 1155 & ji+nimpp-1, jj+njmpp-1, jk 1156 kindic_agr = kindic_agr + 1 1177 1157 ENDIF 1178 1158 END DO … … 1183 1163 ! 1184 1164 END SUBROUTINE interpe3t 1185 1186 1187 SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )1188 !!----------------------------------------------------------------------1189 !! *** ROUTINE interpumsk ***1190 !!----------------------------------------------------------------------1191 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k21192 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1193 LOGICAL , INTENT(in ) :: before1194 INTEGER , INTENT(in ) :: nb , ndir1195 !1196 INTEGER :: ji, jj, jk1197 LOGICAL :: western_side, eastern_side1198 !!----------------------------------------------------------------------1199 !1200 IF( before ) THEN1201 ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)1202 ELSE1203 western_side = (nb == 1).AND.(ndir == 1)1204 eastern_side = (nb == 1).AND.(ndir == 2)1205 DO jk = k1, k21206 DO jj = j1, j21207 DO ji = i1, i21208 ! Velocity mask at boundary edge points:1209 IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN1210 IF (western_side) THEN1211 WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1212 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)1213 kindic_agr = kindic_agr + 11214 ELSEIF (eastern_side) THEN1215 WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1216 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)1217 kindic_agr = kindic_agr + 11218 ENDIF1219 ENDIF1220 END DO1221 END DO1222 END DO1223 !1224 ENDIF1225 !1226 END SUBROUTINE interpumsk1227 1228 1229 SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )1230 !!----------------------------------------------------------------------1231 !! *** ROUTINE interpvmsk ***1232 !!----------------------------------------------------------------------1233 INTEGER , INTENT(in ) :: i1,i2,j1,j2,k1,k21234 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1235 LOGICAL , INTENT(in ) :: before1236 INTEGER , INTENT(in ) :: nb , ndir1237 !1238 INTEGER :: ji, jj, jk1239 LOGICAL :: northern_side, southern_side1240 !!----------------------------------------------------------------------1241 !1242 IF( before ) THEN1243 ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)1244 ELSE1245 southern_side = (nb == 2).AND.(ndir == 1)1246 northern_side = (nb == 2).AND.(ndir == 2)1247 DO jk = k1, k21248 DO jj = j1, j21249 DO ji = i1, i21250 ! Velocity mask at boundary edge points:1251 IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN1252 IF (southern_side) THEN1253 WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1254 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)1255 kindic_agr = kindic_agr + 11256 ELSEIF (northern_side) THEN1257 WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1258 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)1259 kindic_agr = kindic_agr + 11260 ENDIF1261 ENDIF1262 END DO1263 END DO1264 END DO1265 !1266 ENDIF1267 !1268 END SUBROUTINE interpvmsk1269 1165 1270 1166 -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90
r11827 r12119 49 49 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed() 50 50 51 #if defined key_vertical 52 ! Effect of this has to be carrefully checked 53 ! depending on what the nesting tools ensure for 54 ! volume conservation: 51 55 Agrif_UseSpecialValueInUpdate = .FALSE. 52 ! jc_alt Agrif_UseSpecialValueInUpdate = .TRUE. 56 #else 57 Agrif_UseSpecialValueInUpdate = .TRUE. 58 #endif 53 59 Agrif_SpecialValueFineGrid = 0._wp 54 60 ! -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90
r12048 r12119 259 259 ! check if masks and bathymetries match 260 260 IF(ln_chk_bathy) THEN 261 Agrif_UseSpecialValue = .FALSE. 261 262 ! 262 263 IF(lwp) WRITE(numout,*) ' ' … … 266 267 # if ! defined key_vertical 267 268 ! 268 ! check if umask agree with parent along western and eastern boundaries: 269 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 270 ! check if vmask agree with parent along northern and southern boundaries: 271 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 272 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 269 ! check if tmask and vertical scale factors agree with parent in sponge area: 273 270 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 274 271 ! … … 346 343 347 344 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 348 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 349 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 345 350 346 # if defined key_vertical 351 347 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) … … 401 397 402 398 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 403 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)404 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)405 399 406 400 # if defined key_vertical … … 427 421 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 428 422 429 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west, rhox=3, nn_sponge_len=2 430 CALL Agrif_Set_bc( umsk_id, (/0,0/) ) ! and nbghost=3: 431 CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) ! columns 2 to 10 423 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 424 ! JC: check near the boundary only until matching in sponge has been sorted out: 425 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 426 432 427 # if defined key_vertical 433 428 ! extend the interpolation zone by 1 more point than necessary:
Note: See TracChangeset
for help on using the changeset viewer.