Changeset 13251
- Timestamp:
- 2020-07-05T16:59:00+02:00 (5 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90
r13230 r13251 87 87 IF( Agrif_Root() ) RETURN 88 88 ! 89 Agrif_SpecialValue = 0. _wp89 Agrif_SpecialValue = 0.0_wp 90 90 Agrif_UseSpecialValue = ln_spc_dyn 91 91 ! 92 92 use_sign_north = .TRUE. 93 sign_north = -1. 93 sign_north = -1.0_wp 94 94 CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 95 95 CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) … … 106 106 DO ji = mi0(ibdy1), mi1(ibdy2) 107 107 uu_b(ji,:,Krhs_a) = 0._wp 108 109 108 DO jk = 1, jpkm1 110 109 DO jj = 1, jpj … … 112 111 END DO 113 112 END DO 114 115 113 DO jj = 1, jpj 116 114 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) … … 123 121 DO jk = 1, jpkm1 124 122 DO jj = 1, jpj 125 zub(ji,jj) = zub(ji,jj) & 126 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 123 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 127 124 END DO 128 125 END DO 129 126 DO jj=1,jpj 130 127 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 131 END DO 132 128 END DO 133 129 DO jk = 1, jpkm1 134 130 DO jj = 1, jpj 135 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) -zub(ji,jj)) * umask(ji,jj,jk)136 END DO 137 END DO 138 END DO 139 131 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 132 END DO 133 END DO 134 END DO 135 ! 140 136 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 141 137 DO ji = mi0(ibdy1), mi1(ibdy2) … … 151 147 DO jk = 1, jpkm1 152 148 DO jj = 1, jpj 153 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) -zvb(ji,jj))*vmask(ji,jj,jk)149 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk) 154 150 END DO 155 151 END DO 156 152 END DO 157 153 ENDIF 154 ! 158 155 ENDIF 159 156 … … 168 165 DO jk = 1, jpkm1 169 166 DO jj = 1, jpj 170 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) & 171 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 167 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 172 168 END DO 173 169 END DO … … 182 178 DO jk = 1, jpkm1 183 179 DO jj = 1, jpj 184 zub(ji,jj) = zub(ji,jj) & 185 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 180 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 186 181 END DO 187 182 END DO … … 189 184 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 190 185 END DO 191 192 186 DO jk = 1, jpkm1 193 187 DO jj = 1, jpj 194 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 195 & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 196 END DO 197 END DO 198 END DO 199 188 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 189 END DO 190 END DO 191 END DO 192 ! 200 193 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 201 ibdy1 = jpiglo -nbghostcells202 ibdy2 = jpiglo -1194 ibdy1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 195 ibdy2 = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 203 196 DO ji = mi0(ibdy1), mi1(ibdy2) 204 197 zvb(ji,:) = 0._wp 205 198 DO jk = 1, jpkm1 206 199 DO jj = 1, jpj 207 zvb(ji,jj) = zvb(ji,jj) & 208 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 200 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 209 201 END DO 210 202 END DO … … 214 206 DO jk = 1, jpkm1 215 207 DO jj = 1, jpj 216 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 217 & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 208 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 218 209 END DO 219 210 END DO 220 211 END DO 221 212 ENDIF 213 ! 222 214 ENDIF 223 215 … … 232 224 DO jk = 1, jpkm1 233 225 DO ji = 1, jpi 234 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 235 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 226 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 236 227 END DO 237 228 END DO … … 246 237 DO jk=1,jpkm1 247 238 DO ji=1,jpi 248 zvb(ji,jj) = zvb(ji,jj) & 249 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 239 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 250 240 END DO 251 241 END DO … … 253 243 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 254 244 END DO 255 256 245 DO jk = 1, jpkm1 257 246 DO ji = 1, jpi 258 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 259 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 260 END DO 261 END DO 262 END DO 263 247 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 248 END DO 249 END DO 250 END DO 251 ! 264 252 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 265 253 DO jj = mj0(jbdy1), mj1(jbdy2) … … 267 255 DO jk = 1, jpkm1 268 256 DO ji = 1, jpi 269 zub(ji,jj) = zub(ji,jj) & 270 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 257 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 271 258 END DO 272 259 END DO … … 274 261 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 275 262 END DO 276 277 263 DO jk = 1, jpkm1 278 264 DO ji = 1, jpi 279 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 280 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 265 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 281 266 END DO 282 267 END DO 283 268 END DO 284 269 ENDIF 270 ! 285 271 ENDIF 286 272 … … 295 281 DO jk = 1, jpkm1 296 282 DO ji = 1, jpi 297 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 298 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 283 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 299 284 END DO 300 285 END DO … … 309 294 DO jk=1,jpkm1 310 295 DO ji=1,jpi 311 zvb(ji,jj) = zvb(ji,jj) & 312 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 296 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 313 297 END DO 314 298 END DO … … 316 300 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 317 301 END DO 318 319 302 DO jk = 1, jpkm1 320 303 DO ji = 1, jpi 321 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 322 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 323 END DO 324 END DO 325 END DO 326 304 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 305 END DO 306 END DO 307 END DO 308 ! 327 309 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 328 jbdy1 = jpjglo -nbghostcells329 jbdy2 = jpjglo -1310 jbdy1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 311 jbdy2 = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 330 312 DO jj = mj0(jbdy1), mj1(jbdy2) 331 313 zub(:,jj) = 0._wp 332 314 DO jk = 1, jpkm1 333 315 DO ji = 1, jpi 334 zub(ji,jj) = zub(ji,jj) & 335 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 316 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 336 317 END DO 337 318 END DO … … 339 320 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 340 321 END DO 341 342 322 DO jk = 1, jpkm1 343 323 DO ji = 1, jpi 344 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 345 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 324 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 346 325 END DO 347 326 END DO 348 327 END DO 349 328 ENDIF 329 ! 350 330 ENDIF 351 331 ! … … 400 380 jstart = nn_hls + 2 ! halo + land + 1 401 381 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 402 jstart = 2403 jend = nbghostcells+1404 382 DO jj = mj0(jstart), mj1(jend) 405 383 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90
r13232 r13251 78 78 zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 79 79 80 Agrif_SpecialValue =0.80 Agrif_SpecialValue = 0._wp 81 81 Agrif_UseSpecialValue = ln_spc_dyn 82 use_sign_north = .TRUE.83 sign_north = -1.82 use_sign_north = .TRUE. 83 sign_north = -1._wp 84 84 ! 85 85 tabspongedone_u = .FALSE. … … 92 92 ! 93 93 Agrif_UseSpecialValue = .FALSE. 94 use_sign_north = .FALSE.94 use_sign_north = .FALSE. 95 95 #endif 96 96 ! … … 109 109 REAL(wp) :: z1_ispongearea, z1_jspongearea 110 110 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 111 #if defined key_vertical 112 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 113 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 114 #endif 111 115 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 112 116 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth … … 129 133 ! Retrieve masks at open boundaries: 130 134 131 ! --- West --- ! 132 IF( lk_west) THEN 135 IF( lk_west ) THEN ! --- West --- ! 133 136 ztabramp(:,:) = 0._wp 134 137 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells … … 139 142 zmskwest(jpj+1:jpjmax) = 0._wp 140 143 ENDIF 141 142 ! --- East --- ! 143 IF( lk_east ) THEN 144 IF( lk_east ) THEN ! --- East --- ! 144 145 ztabramp(:,:) = 0._wp 145 146 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells … … 150 151 zmskeast(jpj+1:jpjmax) = 0._wp 151 152 ENDIF 152 153 ! --- South --- ! 154 IF( lk_south ) THEN 153 IF( lk_south ) THEN ! --- South --- ! 155 154 ztabramp(:,:) = 0._wp 156 155 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells … … 161 160 zmsksouth(jpi+1:jpimax) = 0._wp 162 161 ENDIF 163 164 ! --- North --- ! 165 IF( lk_north) THEN 162 IF( lk_north ) THEN ! --- North --- ! 166 163 ztabramp(:,:) = 0._wp 167 164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells … … 188 185 ! Store it in ztabramp 189 186 190 ispongearea = nn_sponge_len * Agrif_irhox()191 z1_ispongearea = 1._wp / REAL( ispongearea )192 jspongearea = nn_sponge_len * Agrif_irhoy()193 z1_jspongearea = 1._wp / REAL( jspongearea )187 ispongearea = nn_sponge_len * Agrif_irhox() 188 z1_ispongearea = 1._wp / REAL( ispongearea, wp ) 189 jspongearea = nn_sponge_len * Agrif_irhoy() 190 z1_jspongearea = 1._wp / REAL( jspongearea, wp ) 194 191 195 192 ztabramp(:,:) = 0._wp … … 199 196 IF ( nbcellsy <= 3 ) jspongearea = -1 200 197 201 ! --- West --- ! 202 IF(lk_west) THEN 198 IF( lk_west ) THEN ! --- West --- ! 203 199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 204 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 205 201 DO ji = mi0(ind1), mi1(ind2) 206 202 DO jj = 1, jpj 207 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea* zmskwest(jj)203 ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea * zmskwest(jj) 208 204 END DO 209 205 END DO … … 217 213 END DO 218 214 ENDIF 219 220 ! --- East --- ! 221 IF(lk_east) THEN 215 IF( lk_east ) THEN ! --- East --- ! 222 216 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 223 217 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 224 218 DO ji = mi0(ind1), mi1(ind2) 225 219 DO jj = 1, jpj 226 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj)220 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 227 221 END DO 228 222 END DO … … 235 229 END DO 236 230 END DO 237 ENDIF 238 239 ! --- South --- ! 240 IF( lk_south ) THEN 231 ENDIF 232 IF( lk_south ) THEN ! --- South --- ! 241 233 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 242 234 ind2 = nn_hls + 1 + nbghostcells + jspongearea 243 235 DO jj = mj0(ind1), mj1(ind2) 244 236 DO ji = 1, jpi 245 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji)237 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 246 238 END DO 247 239 END DO … … 255 247 END DO 256 248 ENDIF 257 258 ! --- North --- ! 259 IF( lk_north ) THEN 249 IF( lk_north ) THEN ! --- North --- ! 260 250 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 261 251 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 262 252 DO jj = mj0(ind1), mj1(ind2) 263 253 DO ji = 1, jpi 264 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji)254 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 265 255 END DO 266 256 END DO … … 333 323 ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp ) 334 324 ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp ) 335 CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1. , ztabrampu, 'U', 1., ztabrampv, 'V', 1.)325 CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 336 326 mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 337 327 mbku_parent(:,:) = NINT( ztabrampu(:,:) ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_update.F90
r13229 r13251 85 85 86 86 Agrif_UseSpecialValueInUpdate = .FALSE. 87 Agrif_SpecialValueFineGrid = 0.87 Agrif_SpecialValueFineGrid = 0._wp 88 88 89 89 use_sign_north = .TRUE. 90 sign_north = -1.90 sign_north = -1._wp 91 91 92 92 ! … … 144 144 ! 145 145 Agrif_UseSpecialValueInUpdate = .TRUE. 146 Agrif_SpecialValueFineGrid = 0. 146 Agrif_SpecialValueFineGrid = 0._wp 147 147 # if ! defined DECAL_FEEDBACK_2D 148 148 CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) … … 156 156 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 157 157 use_sign_north = .TRUE. 158 sign_north = -1. 158 sign_north = -1._wp 159 159 ! Refluxing on ssh: 160 160 # if defined DECAL_FEEDBACK_2D -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90
r13247 r13251 11 11 END SUBROUTINE agrif_user 12 12 13 13 14 SUBROUTINE agrif_before_regridding 14 15 END SUBROUTINE agrif_before_regridding 15 16 17 16 18 SUBROUTINE Agrif_InitWorkspace 17 19 END SUBROUTINE Agrif_InitWorkspace 18 20 21 19 22 SUBROUTINE Agrif_InitValues 20 23 !!---------------------------------------------------------------------- … … 38 41 END SUBROUTINE Agrif_initvalues 39 42 40 SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 41 42 USE domvvl 43 USE domain 44 USE par_oce 45 USE agrif_oce 46 USE agrif_oce_interp 47 USE oce 48 USE lib_mpp 49 USe lbclnk 50 43 44 SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 45 !!---------------------------------------------------------------------- 46 !! *** ROUTINE agrif_istate *** 47 !!---------------------------------------------------------------------- 48 USE domvvl 49 USE domain 50 USE par_oce 51 USE agrif_oce 52 USE agrif_oce_interp 53 USE oce 54 USE lib_mpp 55 USE lbclnk 56 ! 57 IMPLICIT NONE 58 ! 51 59 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 52 60 INTEGER :: jn 53 61 !!---------------------------------------------------------------------- 54 62 IF(lwp) WRITE(numout,*) ' ' 55 63 IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 56 64 IF(lwp) WRITE(numout,*) ' ' 57 65 58 l_ini_child = .TRUE.59 Agrif_SpecialValue = 0. _wp66 l_ini_child = .TRUE. 67 Agrif_SpecialValue = 0.0_wp 60 68 Agrif_UseSpecialValue = .TRUE. 61 uu(:,:,:,:) = 0. ; vv(:,:,:,:) = 0. ; ts(:,:,:,:,:) = 0.69 uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp 62 70 63 Krhs_a = Kbb ;Kmm_a = Kbb71 Krhs_a = Kbb ; Kmm_a = Kbb 64 72 65 73 ! Brutal fix to pas 1x1 refinment. … … 79 87 use_sign_north = .FALSE. 80 88 81 Agrif_UseSpecialValue = .FALSE. !82 l_ini_child = .FALSE.83 84 Krhs_a = Kaa ;Kmm_a = Kmm89 Agrif_UseSpecialValue = .FALSE. 90 l_ini_child = .FALSE. 91 92 Krhs_a = Kaa ; Kmm_a = Kmm 85 93 86 94 DO jn = 1, jpts 87 95 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 88 96 END DO 89 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 90 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 91 92 93 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 94 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 95 96 END SUBROUTINE agrif_istate 97 97 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 98 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 99 100 101 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 102 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 103 104 END SUBROUTINE Agrif_Istate 105 106 98 107 SUBROUTINE agrif_declare_var_ini 99 108 !!---------------------------------------------------------------------- 100 !! *** ROUTINE agrif_declare_var ***109 !! *** ROUTINE agrif_declare_var_ini *** 101 110 !!---------------------------------------------------------------------- 102 111 USE agrif_util … … 110 119 ! 111 120 INTEGER :: ind1, ind2, ind3 121 INTEGER :: its 112 122 External :: nemo_mapping 113 123 !!---------------------------------------------------------------------- … … 130 140 ind3 = nn_hls + 2 + nbghostcells_y_s 131 141 132 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 133 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 134 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 135 136 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 137 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 138 142 CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id) 143 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id) 144 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id) 145 146 CALL agrif_declare_variable((/1,2 /),(/ind2-1,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e1u_id) 147 CALL agrif_declare_variable((/2,1 /),(/ind2 ,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e2v_id) 139 148 140 149 ! Initial or restart velues 141 142 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk, jpts+1/),tsini_id)143 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /) ,uini_id)144 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /) ,vini_id)145 CALL agrif_declare_variable((/2,2 /) ,(/ind2,ind3/) ,(/'x','y'/),(/1,1/),(/jpi,jpj/),sshini_id)150 its = jpts+1 151 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 152 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), uini_id) 153 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id) 154 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id) 146 155 ! 147 156 148 157 ! 2. Type of interpolation 149 158 !------------------------- 150 CALL Agrif_Set_bcinterp( e3t_id,interp=AGRIF_constant)151 152 CALL Agrif_Set_bcinterp( mbkt_id,interp=AGRIF_constant)153 CALL Agrif_Set_interp ( mbkt_id,interp=AGRIF_constant)154 CALL Agrif_Set_bcinterp( ht0_id ,interp=AGRIF_constant)155 CALL Agrif_Set_interp ( ht0_id ,interp=AGRIF_constant)156 157 CALL Agrif_Set_bcinterp( e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm )158 CALL Agrif_Set_bcinterp( e2v_id,interp1=AGRIF_ppm , interp2=Agrif_linear )159 CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant) 160 161 CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant) 162 CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant) 163 CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant) 164 CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant) 165 166 CALL Agrif_Set_bcinterp( e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm ) 167 CALL Agrif_Set_bcinterp( e2v_id,interp1=AGRIF_ppm , interp2=Agrif_linear ) 159 168 160 169 ! Initial fields 161 CALL Agrif_Set_bcinterp( tsini_id ,interp=AGRIF_linear)162 CALL Agrif_Set_interp ( tsini_id ,interp=AGRIF_linear)163 CALL Agrif_Set_bcinterp( uini_id ,interp=AGRIF_linear)164 CALL Agrif_Set_interp ( uini_id ,interp=AGRIF_linear)165 CALL Agrif_Set_bcinterp( vini_id ,interp=AGRIF_linear)166 CALL Agrif_Set_interp ( vini_id ,interp=AGRIF_linear)167 CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear)168 CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear)170 CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear ) 171 CALL Agrif_Set_interp ( tsini_id,interp =AGRIF_linear ) 172 CALL Agrif_Set_bcinterp( uini_id,interp =AGRIF_linear ) 173 CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear ) 174 CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear ) 175 CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear ) 176 CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear ) 177 CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear ) 169 178 170 179 ! 3. Location of interpolation … … 172 181 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 173 182 ! JC: check near the boundary only until matching in sponge has been sorted out: 174 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) )183 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 175 184 176 185 ! extend the interpolation zone by 1 more point than necessary: 177 186 ! RB check here 178 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )179 CALL Agrif_Set_bc( ht0_id,(/-nn_sponge_len*Agrif_irhox()-2,ind1/) )187 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 188 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 180 189 181 CALL Agrif_Set_bc( e1u_id,(/0,ind1-1/))182 CALL Agrif_Set_bc( e2v_id,(/0,ind1-1/))183 184 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4185 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) )186 CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) )190 CALL Agrif_Set_bc( e1u_id, (/0,ind1-1/) ) 191 CALL Agrif_Set_bc( e2v_id, (/0,ind1-1/) ) 192 193 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 194 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) ) 195 CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) ) 187 196 CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 188 197 … … 190 199 !--------------- 191 200 # if defined UPD_HIGH 192 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting)193 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average )201 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting) 202 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average ) 194 203 #else 195 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average)196 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy)204 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average ) 205 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy ) 197 206 #endif 198 207 … … 204 213 SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 205 214 !!---------------------------------------------------------------------- 206 !! *** ROUTINE Agrif_InitValues_cont_dom *** 207 !!---------------------------------------------------------------------- 208 209 !!---------------------------------------------------------------------- 210 !! *** ROUTINE Agrif_InitValues_cont *** 211 !! 212 !! ** Purpose :: Declaration of variables to be interpolated 213 !!---------------------------------------------------------------------- 215 !! *** ROUTINE Agrif_Init_Domain *** 216 !!---------------------------------------------------------------------- 214 217 USE agrif_oce_update 215 218 USE agrif_oce_interp … … 243 246 ! on the child grid 244 247 Agrif_UseSpecialValue = .FALSE. 245 ht0_parent( :,:) = 0._wp248 ht0_parent( :,:) = 0._wp 246 249 mbkt_parent(:,:) = 0 247 250 ! … … 255 258 ! and no refinement 256 259 DO_2D_10_10 257 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ) , mbkt_parent(ji,jj))258 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1) , mbkt_parent(ji,jj))260 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ), mbkt_parent(ji,jj) ) 261 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1), mbkt_parent(ji,jj) ) 259 262 END_2D 260 263 IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN … … 265 268 ELSE 266 269 DO_2D_10_10 267 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )268 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )270 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 271 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 269 272 END_2D 270 271 ENDIF 272 ! 273 CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp ) 274 CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1.0_wp ) 275 zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk('Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 276 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 277 zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 273 ENDIF 274 ! 275 CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 276 DO_2D_00_00 277 zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 278 END_2D 279 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 280 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 281 DO_2D_00_00 282 zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 283 END_2D 284 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 278 285 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 279 286 … … 333 340 334 341 SUBROUTINE Agrif_InitValues_cont 335 336 337 338 339 342 !!---------------------------------------------------------------------- 343 !! *** ROUTINE Agrif_InitValues_cont *** 344 !! 345 !! ** Purpose :: Declaration of variables to be interpolated 346 !!---------------------------------------------------------------------- 340 347 USE agrif_oce_update 341 348 USE agrif_oce_interp … … 367 374 Agrif_SpecialValue = 0._wp 368 375 Agrif_UseSpecialValue = .TRUE. 369 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn)376 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn) 370 377 CALL Agrif_Sponge 371 378 tabspongedone_tsn = .FALSE. … … 398 405 use_sign_north = .TRUE. 399 406 sign_north = -1. 400 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb)401 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb)407 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb ) 408 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb ) 402 409 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 403 410 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) … … 506 513 ! 2. Type of interpolation 507 514 !------------------------- 508 CALL Agrif_Set_bcinterp( tsn_id,interp=AGRIF_linear)509 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)510 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)511 512 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp=AGRIF_linear)513 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)514 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)515 516 CALL Agrif_Set_bcinterp( sshn_id,interp=AGRIF_linear)517 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)518 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)519 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )520 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)515 CALL Agrif_Set_bcinterp( tsn_id,interp =AGRIF_linear) 516 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 517 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 518 519 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 520 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 521 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 522 523 CALL Agrif_Set_bcinterp( sshn_id,interp =AGRIF_linear) 524 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 525 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 526 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 527 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 521 528 ! 522 529 ! > Divergence conserving alternative: … … 558 565 559 566 # if defined UPD_HIGH 560 CALL Agrif_Set_Updatetype( tsn_id, update= Agrif_Update_Full_Weighting)561 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)562 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )563 564 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)565 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )566 CALL Agrif_Set_Updatetype( sshn_id,update= Agrif_Update_Full_Weighting)567 CALL Agrif_Set_Updatetype( e3t_id, update= Agrif_Update_Full_Weighting)567 CALL Agrif_Set_Updatetype( tsn_id,update = Agrif_Update_Full_Weighting) 568 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 569 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 570 571 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 572 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 573 CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting) 574 CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting) 568 575 569 576 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN … … 574 581 575 582 #else 576 CALL Agrif_Set_Updatetype( tsn_id, update= AGRIF_Update_Average)577 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)578 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )579 580 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)581 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )582 CALL Agrif_Set_Updatetype( sshn_id,update= AGRIF_Update_Average)583 CALL Agrif_Set_Updatetype( e3t_id, update= AGRIF_Update_Average)583 CALL Agrif_Set_Updatetype( tsn_id, update = AGRIF_Update_Average) 584 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 585 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 586 587 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 588 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 589 CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average) 590 CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average) 584 591 585 592 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN … … 594 601 595 602 #if defined key_si3 596 SUBROUTINE Agrif_InitValues_cont_ice 603 SUBROUTINE Agrif_InitValues_cont_ice 604 !!---------------------------------------------------------------------- 605 !! *** ROUTINE Agrif_InitValues_cont_ice *** 606 !!---------------------------------------------------------------------- 597 607 USE Agrif_Util 598 608 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc … … 602 612 USE agrif_ice_interp 603 613 USE lib_mpp 604 ! !----------------------------------------------------------------------605 !! *** ROUTINE Agrif_InitValues_cont_ice ***606 ! !----------------------------------------------------------------------607 614 ! 615 IMPLICIT NONE 616 ! 617 !!---------------------------------------------------------------------- 608 618 ! Controls 609 619 … … 628 638 END SUBROUTINE Agrif_InitValues_cont_ice 629 639 640 630 641 SUBROUTINE agrif_declare_var_ice 631 642 !!---------------------------------------------------------------------- 632 643 !! *** ROUTINE agrif_declare_var_ice *** 633 644 !!---------------------------------------------------------------------- 634 635 645 USE Agrif_Util 636 646 USE ice 637 USE par_oce 647 USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 638 648 ! 639 649 IMPLICIT NONE 640 650 ! 641 651 INTEGER :: ind1, ind2, ind3 642 !!---------------------------------------------------------------------- 652 INTEGER :: ipl 653 !!---------------------------------------------------------------------- 643 654 ! 644 655 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) … … 652 663 ind2 = nn_hls + 2 + nbghostcells_x 653 664 ind3 = nn_hls + 2 + nbghostcells_y_s 654 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 655 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id ) 656 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_ice_id ) 657 658 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 659 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_iceini_id ) 660 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_iceini_id ) 665 ipl = jpl*(8+nlay_s+nlay_i) 666 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 667 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id) 668 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id) 669 670 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 671 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id) 672 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id) 661 673 662 674 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 716 728 USE agrif_top_interp 717 729 USE agrif_top_sponge 718 !! 719 720 !! 721 IMPLICIT NONE 722 ! 723 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 724 LOGICAL :: check_namelist 725 !!---------------------------------------------------------------------- 726 727 728 ! 1. Declaration of the type of variable which have to be interpolated 729 !--------------------------------------------------------------------- 730 CALL agrif_declare_var_top 731 732 ! 2. First interpolations of potentially non zero fields 733 !------------------------------------------------------- 734 Agrif_SpecialValue=0. 735 Agrif_UseSpecialValue = .TRUE. 736 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 737 Agrif_UseSpecialValue = .FALSE. 738 CALL Agrif_Sponge 739 tabspongedone_trn = .FALSE. 740 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 741 ! reset tsa to zero 742 tra(:,:,:,:) = 0. 743 744 ! 3. Some controls 745 !----------------- 746 check_namelist = .TRUE. 747 748 IF( check_namelist ) THEN 749 ! Check time steps 750 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 751 WRITE(cl_check1,*) Agrif_Parent(rdt) 752 WRITE(cl_check2,*) rdt 753 WRITE(cl_check3,*) rdt*Agrif_Rhot() 754 CALL ctl_stop( 'incompatible time step between grids', & 730 ! 731 IMPLICIT NONE 732 ! 733 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 734 LOGICAL :: check_namelist 735 !!---------------------------------------------------------------------- 736 737 ! 1. Declaration of the type of variable which have to be interpolated 738 !--------------------------------------------------------------------- 739 CALL agrif_declare_var_top 740 741 ! 2. First interpolations of potentially non zero fields 742 !------------------------------------------------------- 743 Agrif_SpecialValue=0._wp 744 Agrif_UseSpecialValue = .TRUE. 745 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 746 Agrif_UseSpecialValue = .FALSE. 747 CALL Agrif_Sponge 748 tabspongedone_trn = .FALSE. 749 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 750 ! reset tsa to zero 751 tra(:,:,:,:) = 0._wp 752 753 ! 3. Some controls 754 !----------------- 755 check_namelist = .TRUE. 756 757 IF( check_namelist ) THEN 758 ! Check time steps 759 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 760 WRITE(cl_check1,*) Agrif_Parent(rdt) 761 WRITE(cl_check2,*) rdt 762 WRITE(cl_check3,*) rdt*Agrif_Rhot() 763 CALL ctl_stop( 'incompatible time step between grids', & 755 764 & 'parent grid value : '//cl_check1 , & 756 765 & 'child grid value : '//cl_check2 , & 757 766 & 'value on child grid should be changed to & 758 767 & :'//cl_check3 ) 759 ENDIF760 761 ! Check run length762 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &768 ENDIF 769 770 ! Check run length 771 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 763 772 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 764 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1765 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()766 CALL ctl_warn( 'incompatible run length between grids' , &773 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 774 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 775 CALL ctl_warn( 'incompatible run length between grids' , & 767 776 & ' nit000 on fine grid will be change to : '//cl_check1, & 768 777 & ' nitend on fine grid will be change to : '//cl_check2 ) 769 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1770 nitend = Agrif_Parent(nitend) *Agrif_IRhot()771 ENDIF772 ENDIF773 !778 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 779 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 780 ENDIF 781 ENDIF 782 ! 774 783 END SUBROUTINE Agrif_InitValues_cont_top 775 784 … … 788 797 INTEGER :: ind1, ind2, ind3 789 798 !!---------------------------------------------------------------------- 790 791 792 793 799 !RB_CMEMS : declare here init for top 794 800 ! 1. Declaration of the type of variable which have to be interpolated … … 826 832 END SUBROUTINE agrif_declare_var_top 827 833 # endif 834 828 835 829 836 SUBROUTINE Agrif_detect( kg, ksizex ) … … 839 846 END SUBROUTINE Agrif_detect 840 847 848 841 849 SUBROUTINE agrif_nemo_init 842 850 !!---------------------------------------------------------------------- 843 851 !! *** ROUTINE agrif_init *** 844 852 !!---------------------------------------------------------------------- 845 USE agrif_oce846 USE agrif_ice847 USE dom_oce848 USE in_out_manager849 USE lib_mpp850 ! !853 USE agrif_oce 854 USE agrif_ice 855 USE dom_oce 856 USE in_out_manager 857 USE lib_mpp 858 ! 851 859 IMPLICIT NONE 852 860 ! … … 899 907 END SUBROUTINE agrif_nemo_init 900 908 909 901 910 # if defined key_mpp_mpi 902 911 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) … … 919 928 END SUBROUTINE Agrif_InvLoc 920 929 930 921 931 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 922 932 !!---------------------------------------------------------------------- … … 938 948 END SUBROUTINE Agrif_get_proc_info 939 949 950 940 951 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 941 952 !!---------------------------------------------------------------------- … … 1132 1143 FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 1133 1144 1134 USE dom_oce 1135 1136 INTEGER :: ptx, pty, i1, isens 1137 INTEGER :: agrif_external_switch_index 1138 1139 IF( isens == 1 ) THEN 1140 IF( ptx == 2 ) THEN ! T, V points 1141 agrif_external_switch_index = jpiglo-i1+2 1142 ELSE ! U, F points 1143 agrif_external_switch_index = jpiglo-i1+1 1144 ENDIF 1145 ELSE IF( isens ==2 ) THEN 1146 IF ( pty == 2 ) THEN ! T, U points 1147 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1148 ELSE ! V, F points 1149 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1150 ENDIF 1151 ENDIF 1145 USE dom_oce 1146 ! 1147 IMPLICIT NONE 1148 1149 INTEGER :: ptx, pty, i1, isens 1150 INTEGER :: agrif_external_switch_index 1151 !!---------------------------------------------------------------------- 1152 1153 IF( isens == 1 ) THEN 1154 IF( ptx == 2 ) THEN ! T, V points 1155 agrif_external_switch_index = jpiglo-i1+2 1156 ELSE ! U, F points 1157 agrif_external_switch_index = jpiglo-i1+1 1158 ENDIF 1159 ELSE IF( isens ==2 ) THEN 1160 IF ( pty == 2 ) THEN ! T, U points 1161 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1162 ELSE ! V, F points 1163 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1164 ENDIF 1165 ENDIF 1152 1166 1153 1167 END FUNCTION agrif_external_switch_index … … 1157 1171 !! *** ROUTINE Correct_field *** 1158 1172 !!---------------------------------------------------------------------- 1159 1160 USE dom_oce 1161 USE agrif_oce 1162 1163 INTEGER :: i1,i2,j1,j2 1164 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1165 1166 INTEGER :: i,j 1167 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1168 1169 tab2dtemp = tab2d 1170 1171 IF( .NOT. use_sign_north ) THEN 1172 DO j=j1,j2 1173 DO i=i1,i2 1174 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1173 USE dom_oce 1174 USE agrif_oce 1175 ! 1176 IMPLICIT NONE 1177 ! 1178 INTEGER :: i1,i2,j1,j2 1179 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1180 ! 1181 INTEGER :: i,j 1182 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1183 !!---------------------------------------------------------------------- 1184 1185 tab2dtemp = tab2d 1186 1187 IF( .NOT. use_sign_north ) THEN 1188 DO j=j1,j2 1189 DO i=i1,i2 1190 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1191 END DO 1175 1192 END DO 1176 E ND DO1177 ELSE1178 DO j=j1,j21179 DO i=i1,i21180 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))1193 ELSE 1194 DO j=j1,j2 1195 DO i=i1,i2 1196 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 1197 END DO 1181 1198 END DO 1182 END DO 1183 ENDIF 1199 ENDIF 1184 1200 1185 1201 END SUBROUTINE Correct_field -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/sshwzv.F90
r13248 r13251 222 222 ! inside computational domain (cosmetic) 223 223 DO jk = 1, jpkm1 224 ! --- West --- ! 225 IF( lk_west) THEN 224 IF( lk_west ) THEN ! --- West --- ! 226 225 DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 227 226 DO jj = 1, jpj … … 230 229 END DO 231 230 ENDIF 232 ! 233 ! --- East --- ! 234 IF( lk_east) THEN 231 IF( lk_east ) THEN ! --- East --- ! 235 232 DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 236 233 DO jj = 1, jpj … … 239 236 END DO 240 237 ENDIF 241 ! 242 ! --- South --- ! 243 IF( lk_south) THEN 238 IF( lk_south ) THEN ! --- South --- ! 244 239 DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 245 240 DO ji = 1, jpi … … 248 243 END DO 249 244 ENDIF 250 ! 251 ! --- North --- ! 252 IF( lk_north) THEN 245 IF( lk_north ) THEN ! --- North --- ! 253 246 DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 254 247 DO ji = 1, jpi -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13236 r13251 339 339 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 340 340 341 #if defined key_agrif 342 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) 343 CALL agrif_nemo_init() 344 ENDIF 345 #endif 341 346 ! 342 347 ! 2. Index arrays for subdomains … … 550 555 njmpp = ijmppt(ii,ij) 551 556 jpk = jpkglo ! third dim 552 #if defined key_agrif553 ! simple trick to use same vertical grid as parent but different number of levels:554 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.555 ! Suppress once vertical online interpolation is ok556 !!$ IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )557 #endif558 557 ! 559 558 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_nam.F90
r13247 r13251 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce 16 17 USE par_oce ! ocean space and time domain 17 18 USE phycst ! physical constants … … 73 74 #if defined key_agrif 74 75 IF( .NOT.Agrif_Root() ) THEN ! Global Domain size: add 1 land point on each side 75 kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 76 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 76 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) 77 kpj = nbcellsy + 2 * ( nbghostcells + 1 ) 78 !!$ kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 79 !!$ kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 77 80 ENDIF 78 81 #endif -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90
r13238 r13251 88 88 kpj = kpj - 2 ! for compatibility with old version (because kerio=7) --> to be removed 89 89 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 90 kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 91 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 90 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) 91 kpj = nbcellsy + 2 * ( nbghostcells + 1 ) 92 !!$ kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 93 !!$ kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 92 94 ENDIF 93 95 kpk = 2 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/VORTEX/MY_SRC/usrdef_nam.F90
r13238 r13251 85 85 kpj = NINT( 1800.e3 / rn_dy ) + 3 86 86 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 87 kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 88 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 87 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) 88 kpj = nbcellsy + 2 * ( nbghostcells + 1 ) 89 !!$ kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 90 !!$ kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 89 91 ENDIF 90 92 kpk = NINT( 5000._wp / rn_dz ) + 1
Note: See TracChangeset
for help on using the changeset viewer.