Changeset 8129
- Timestamp:
- 2017-06-02T16:08:12+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7761 r8129 52 52 !!----------------------------------------------------------------------- 53 53 ! 54 IF( Agrif_Root() ) RETURN54 IF( Agrif_Root() .OR. nn_ice==0 ) RETURN ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 55 55 ! 56 56 SELECT CASE(cd_type) … … 154 154 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 155 155 LOGICAL :: western_side, eastern_side, northern_side, southern_side 156 INTEGER :: ind1, ind2, ind3 156 157 157 158 !!----------------------------------------------------------------------- … … 233 234 ! ! Remove corners 234 235 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 235 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 236 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 237 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 238 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 236 ! !!clem2017 ghost 237 ! ind1 = nbghostcells 238 ! ind2 = 1 + nbghostcells 239 ! ind3 = 2 + nbghostcells 240 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = ind3 241 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-ind2 242 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = ind3 243 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-ind2 244 ! !!clem2017 ghost 239 245 ! 240 246 ! ! smoothed fields -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r7761 r8129 56 56 IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 57 57 ! i.e. update only at the parent time step 58 IF( nn_ice == 0 ) RETURN ! clem2017: do not update if child domain does not have ice 59 ! 58 60 Agrif_UseSpecialValueInUpdate = .TRUE. 59 61 Agrif_SpecialValueFineGrid = -9999. -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r8129 35 35 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 36 36 PUBLIC interpun, interpvn 37 PUBLIC interptsn, 37 PUBLIC interptsn, interpsshn 38 38 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 39 39 PUBLIC interpe3t, interpumsk, interpvmsk … … 100 100 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2 101 101 102 ! --- West --- ! 102 103 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 103 104 ! 104 ! Smoothing105 ! ---------106 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 107 ua_b( 2,:) = 0._wp106 ua_b(1:1+nbghostcells,:) = 0._wp 108 107 DO jk = 1, jpkm1 109 108 DO jj = 1, jpj 110 ua_b( 2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)109 ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) + e3u_a(1:1+nbghostcells,jj,jk) * ua(1:1+nbghostcells,jj,jk) 111 110 END DO 112 111 END DO 113 112 DO jj = 1, jpj 114 ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj) 115 END DO 116 ENDIF 117 ! 118 DO jk=1,jpkm1 ! Smooth 119 DO jj=j1,j2 120 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 121 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 122 END DO 123 END DO 124 ! 125 zub(2,:) = 0._wp ! Correct transport 126 DO jk = 1, jpkm1 127 DO jj = 1, jpj 128 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 129 END DO 130 END DO 131 DO jj=1,jpj 132 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 133 END DO 134 135 DO jk=1,jpkm1 136 DO jj=1,jpj 137 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 138 END DO 139 END DO 140 141 ! Set tangential velocities to time splitting estimate 142 !----------------------------------------------------- 143 IF( ln_dynspg_ts ) THEN 144 zvb(2,:) = 0._wp 113 ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) * r1_hu_a(1:1+nbghostcells,jj) 114 END DO 115 ENDIF 116 ! 117 ! Smoothing if only 1 ghostcell 118 ! ----------------------------- 119 IF( nbghostcells == 1 ) THEN 120 DO jk=1,jpkm1 ! Smooth 121 DO jj=j1,j2 122 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 123 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 124 END DO 125 END DO 126 ! 127 zub(2,:) = 0._wp ! Correct transport 145 128 DO jk = 1, jpkm1 146 129 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 130 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 131 END DO 132 END DO 133 DO jj=1,jpj 134 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 135 END DO 136 137 DO jk=1,jpkm1 138 DO jj=1,jpj 139 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 140 END DO 141 END DO 142 143 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 144 zvb(2,:) = 0._wp 145 DO jk = 1, jpkm1 146 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 153 DO jk = 1, jpkm1 154 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ENDIF 161 ! 162 ENDIF 163 164 ! --- East --- ! 165 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 166 167 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 168 ua_b(nlci-nbghostcells-1:nlci,:) = 0._wp 169 DO jk=1,jpkm1 170 DO jj=1,jpj 171 ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) + e3u_a(nlci-nbghostcells-1:nlci,jj,jk) & 172 & * ua(nlci-nbghostcells-1:nlci,jj,jk) 173 END DO 174 END DO 175 DO jj=1,jpj 176 ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) * r1_hu_a(nlci-nbghostcells-1:nlci,jj) 177 END DO 178 ENDIF 179 ! 180 ! Smoothing if only 1 ghostcell 181 ! ----------------------------- 182 IF( nbghostcells == 1 ) THEN 183 DO jk = 1, jpkm1 ! Smooth 184 DO jj = j1, j2 185 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 186 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 187 END DO 188 END DO 189 190 zub(nlci-2,:) = 0._wp ! Correct transport 153 191 DO jk = 1, jpkm1 154 192 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ! Mask domain edges: 161 !------------------- 162 DO jk = 1, jpkm1 193 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 194 END DO 195 END DO 163 196 DO jj = 1, jpj 164 ua(1,jj,jk) = 0._wp 165 va(1,jj,jk) = 0._wp 166 END DO 167 END DO 168 ! 169 ENDIF 170 171 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 172 173 ! Smoothing 174 ! --------- 175 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 176 ua_b(nlci-2,:) = 0._wp 177 DO jk=1,jpkm1 178 DO jj=1,jpj 179 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 180 END DO 181 END DO 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj) 184 END DO 185 ENDIF 186 187 DO jk = 1, jpkm1 ! Smooth 188 DO jj = j1, j2 189 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 190 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 191 END DO 192 END DO 193 194 zub(nlci-2,:) = 0._wp ! Correct transport 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 198 END DO 199 END DO 200 DO jj = 1, jpj 201 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 202 END DO 203 204 DO jk = 1, jpkm1 205 DO jj = 1, jpj 206 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 207 END DO 208 END DO 209 ! 210 ! Set tangential velocities to time splitting estimate 211 !----------------------------------------------------- 212 IF( ln_dynspg_ts ) THEN 213 zvb(nlci-1,:) = 0._wp 197 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 198 END DO 199 214 200 DO jk = 1, jpkm1 215 201 DO jj = 1, jpj 216 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 217 END DO 218 END DO 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 221 END DO 222 DO jk = 1, jpkm1 223 DO jj = 1, jpj 224 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 225 END DO 226 END DO 227 ENDIF 228 ! 229 ! Mask domain edges: 230 !------------------- 231 DO jk = 1, jpkm1 232 DO jj = 1, jpj 233 ua(nlci-1,jj,jk) = 0._wp 234 va(nlci ,jj,jk) = 0._wp 235 END DO 236 END DO 237 ! 238 ENDIF 239 202 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 203 END DO 204 END DO 205 ! 206 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 207 zvb(nlci-1,:) = 0._wp 208 DO jk = 1, jpkm1 209 DO jj = 1, jpj 210 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 211 END DO 212 END DO 213 DO jj=1,jpj 214 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 215 END DO 216 DO jk = 1, jpkm1 217 DO jj = 1, jpj 218 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 219 END DO 220 END DO 221 ENDIF 222 ! 223 ENDIF 224 ! 225 ENDIF 226 227 ! --- South --- ! 240 228 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 241 229 242 ! Smoothing243 ! ---------244 230 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 245 va_b(:, 2) = 0._wp231 va_b(:,1:nbghostcells+1) = 0._wp 246 232 DO jk = 1, jpkm1 247 233 DO ji = 1, jpi 248 va_b(ji, 2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)234 va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) + e3v_a(ji,1:nbghostcells+1,jk) * va(ji,1:nbghostcells+1,jk) 249 235 END DO 250 236 END DO 251 237 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2) 253 END DO 254 ENDIF 255 ! 256 DO jk = 1, jpkm1 ! Smooth 257 DO ji = i1, i2 258 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 259 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 260 END DO 261 END DO 262 ! 263 zvb(:,2) = 0._wp ! Correct transport 264 DO jk=1,jpkm1 265 DO ji=1,jpi 266 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 267 END DO 268 END DO 269 DO ji = 1, jpi 270 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 271 END DO 272 DO jk = 1, jpkm1 238 va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) * r1_hv_a(ji,1:nbghostcells+1) 239 END DO 240 ENDIF 241 ! 242 ! Smoothing if only 1 ghostcell 243 ! ----------------------------- 244 IF( nbghostcells == 1 ) THEN 245 DO jk = 1, jpkm1 ! Smooth 246 DO ji = i1, i2 247 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 248 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 249 END DO 250 END DO 251 ! 252 zvb(:,2) = 0._wp ! Correct transport 253 DO jk=1,jpkm1 254 DO ji=1,jpi 255 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 256 END DO 257 END DO 273 258 DO ji = 1, jpi 274 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 275 END DO 276 END DO 277 278 ! Set tangential velocities to time splitting estimate 279 !----------------------------------------------------- 280 IF( ln_dynspg_ts ) THEN 281 zub(:,2) = 0._wp 259 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 260 END DO 282 261 DO jk = 1, jpkm1 283 262 DO ji = 1, jpi 284 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 285 END DO 286 END DO 287 DO ji = 1, jpi 288 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 289 END DO 290 263 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 264 END DO 265 END DO 266 267 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 268 zub(:,2) = 0._wp 269 DO jk = 1, jpkm1 270 DO ji = 1, jpi 271 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 272 END DO 273 END DO 274 DO ji = 1, jpi 275 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 276 END DO 277 278 DO jk = 1, jpkm1 279 DO ji = 1, jpi 280 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 281 END DO 282 END DO 283 ENDIF 284 ! 285 ENDIF 286 ! 287 ENDIF 288 289 ! --- North --- ! 290 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 291 ! 292 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 293 va_b(:,nlcj-nbghostcells-1:nlcj) = 0._wp 291 294 DO jk = 1, jpkm1 292 295 DO ji = 1, jpi 293 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 294 END DO 295 END DO 296 ENDIF 297 298 ! Mask domain edges: 299 !------------------- 300 DO jk = 1, jpkm1 296 va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) + e3v_a(ji,nlcj-nbghostcells-1:nlcj,jk) & 297 & * va(ji,nlcj-nbghostcells-1:nlcj,jk) 298 END DO 299 END DO 301 300 DO ji = 1, jpi 302 ua(ji,1,jk) = 0._wp 303 va(ji,1,jk) = 0._wp 304 END DO 305 END DO 306 307 ENDIF 308 309 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 310 ! 311 ! Smoothing 312 ! --------- 313 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 314 va_b(:,nlcj-2) = 0._wp 301 va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj) 302 END DO 303 ENDIF 304 ! 305 ! Smoothing if only 1 ghostcell 306 ! ----------------------------- 307 IF( nbghostcells == 1 ) THEN 308 DO jk = 1, jpkm1 ! Smooth 309 DO ji = i1, i2 310 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 311 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 312 END DO 313 END DO 314 ! 315 zvb(:,nlcj-2) = 0._wp ! Correct transport 315 316 DO jk = 1, jpkm1 316 317 DO ji = 1, jpi 317 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)318 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 318 319 END DO 319 320 END DO 320 321 DO ji = 1, jpi 321 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 322 END DO 323 ENDIF 324 ! 325 DO jk = 1, jpkm1 ! Smooth 326 DO ji = i1, i2 327 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 328 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 329 END DO 330 END DO 331 ! 332 zvb(:,nlcj-2) = 0._wp ! Correct transport 333 DO jk = 1, jpkm1 334 DO ji = 1, jpi 335 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 336 END DO 337 END DO 338 DO ji = 1, jpi 339 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 340 END DO 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 344 END DO 345 END DO 346 ! 347 ! Set tangential velocities to time splitting estimate 348 !----------------------------------------------------- 349 IF( ln_dynspg_ts ) THEN 350 zub(:,nlcj-1) = 0._wp 322 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 323 END DO 351 324 DO jk = 1, jpkm1 352 325 DO ji = 1, jpi 353 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 354 END DO 355 END DO 356 DO ji = 1, jpi 357 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 358 END DO 359 ! 360 DO jk = 1, jpkm1 326 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 327 END DO 328 END DO 329 ! 330 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 331 zub(:,nlcj-1) = 0._wp 332 DO jk = 1, jpkm1 333 DO ji = 1, jpi 334 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 335 END DO 336 END DO 361 337 DO ji = 1, jpi 362 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 363 END DO 364 END DO 365 ENDIF 366 ! 367 ! Mask domain edges: 368 !------------------- 369 DO jk = 1, jpkm1 370 DO ji = 1, jpi 371 ua(ji,nlcj ,jk) = 0._wp 372 va(ji,nlcj-1,jk) = 0._wp 373 END DO 374 END DO 338 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 339 END DO 340 ! 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 344 END DO 345 END DO 346 ENDIF 347 ! 348 ENDIF 375 349 ! 376 350 ENDIF … … 392 366 ! 393 367 IF( Agrif_Root() ) RETURN 394 ! 368 !! clem ghost 395 369 IF((nbondi == -1).OR.(nbondi == 2)) THEN 396 370 DO jj=1,jpj 397 va_e( 2,jj) = vbdy_w(jj) * hvr_e(2,jj)371 va_e(1:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(1:nbghostcells+1,jj) 398 372 ! Specified fluxes: 399 ua_e( 2,jj) = ubdy_w(jj) * hur_e(2,jj)400 ! Characteristics method :373 ua_e(1:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(1:nbghostcells+1,jj) 374 ! Characteristics method (only if ghostcells=1): 401 375 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 402 376 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) … … 406 380 IF((nbondi == 1).OR.(nbondi == 2)) THEN 407 381 DO jj=1,jpj 408 va_e(nlci- 1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)382 va_e(nlci-nbghostcells:nlci,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci,jj) 409 383 ! Specified fluxes: 410 ua_e(nlci- 2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)411 ! Characteristics method :384 ua_e(nlci-nbghostcells-1:nlci-1,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-1,jj) 385 ! Characteristics method (only if ghostcells=1): 412 386 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 413 387 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) … … 417 391 IF((nbondj == -1).OR.(nbondj == 2)) THEN 418 392 DO ji=1,jpi 419 ua_e(ji, 2) = ubdy_s(ji) * hur_e(ji,2)393 ua_e(ji,1:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,1:nbghostcells+1) 420 394 ! Specified fluxes: 421 va_e(ji, 2) = vbdy_s(ji) * hvr_e(ji,2)422 ! Characteristics method :395 va_e(ji,1:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,1:nbghostcells+1) 396 ! Characteristics method (only if ghostcells=1): 423 397 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 424 398 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) … … 428 402 IF((nbondj == 1).OR.(nbondj == 2)) THEN 429 403 DO ji=1,jpi 430 ua_e(ji,nlcj- 1) = ubdy_n(ji) * hur_e(ji,nlcj-1)404 ua_e(ji,nlcj-nbghostcells:nlcj) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj) 431 405 ! Specified fluxes: 432 va_e(ji,nlcj- 2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)433 ! Characteristics method :406 va_e(ji,nlcj-nbghostcells-1:nlcj-1) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-1) 407 ! Characteristics method (only if ghostcells=1): 434 408 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 435 409 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) … … 476 450 ! 477 451 IF( ll_int_cons ) THEN ! Conservative interpolation 478 ! order smatters here !!!!!!452 ! order matters here !!!!!! 479 453 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 480 454 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) … … 504 478 !!---------------------------------------------------------------------- 505 479 INTEGER, INTENT(in) :: kt 506 !! 480 ! 481 INTEGER :: ji, jj, indx 507 482 !!---------------------------------------------------------------------- 508 483 ! 509 484 IF( Agrif_Root() ) RETURN 510 ! 485 !! clem ghost 486 ! --- West --- ! 511 487 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 514 ENDIF 515 ! 488 indx = 1+nbghostcells 489 DO jj = 1, jpj 490 DO ji = 1, indx 491 ssha(ji,jj)=ssha(indx+1,jj) 492 sshn(ji,jj)=sshn(indx+1,jj) 493 ENDDO 494 ENDDO 495 ENDIF 496 ! 497 ! --- East --- ! 516 498 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 519 ENDIF 520 ! 499 indx = nlci-nbghostcells 500 DO jj = 1, jpj 501 DO ji = indx, nlci 502 ssha(ji,jj)=ssha(indx-1,jj) 503 sshn(ji,jj)=sshn(indx-1,jj) 504 ENDDO 505 ENDDO 506 ENDIF 507 ! 508 ! --- South --- ! 521 509 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 524 ENDIF 525 ! 510 indx = 1+nbghostcells 511 DO jj = 1, indx 512 DO ji = 1, jpi 513 ssha(ji,jj)=ssha(ji,indx+1) 514 sshn(ji,jj)=sshn(ji,indx+1) 515 ENDDO 516 ENDDO 517 ENDIF 518 ! 519 ! --- North --- ! 526 520 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 521 indx = nlcj-nbghostcells 522 DO jj = indx, nlcj 523 DO ji = 1, jpi 524 ssha(ji,jj)=ssha(ji,indx-1) 525 sshn(ji,jj)=sshn(ji,indx-1) 526 ENDDO 527 ENDDO 529 528 ENDIF 530 529 ! … … 538 537 INTEGER, INTENT(in) :: jn 539 538 !! 540 INTEGER :: ji, jj541 !!---------------------------------------------------------------------- 542 ! 539 INTEGER :: ji, jj 540 !!---------------------------------------------------------------------- 541 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 543 542 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 543 DO jj = 1, jpj 545 ssha_e( 2,jj) = hbdy_w(jj)544 ssha_e(1:nbghostcells+1,jj) = hbdy_w(jj) 546 545 END DO 547 546 ENDIF … … 549 548 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 549 DO jj = 1, jpj 551 ssha_e(nlci- 1,jj) = hbdy_e(jj)550 ssha_e(nlci-nbghostcells:nlci,jj) = hbdy_e(jj) 552 551 END DO 553 552 ENDIF … … 555 554 IF((nbondj == -1).OR.(nbondj == 2)) THEN 556 555 DO ji = 1, jpi 557 ssha_e(ji, 2) = hbdy_s(ji)556 ssha_e(ji,1:nbghostcells+1) = hbdy_s(ji) 558 557 END DO 559 558 ENDIF … … 561 560 IF((nbondj == 1).OR.(nbondj == 2)) THEN 562 561 DO ji = 1, jpi 563 ssha_e(ji,nlcj- 1) = hbdy_n(ji)562 ssha_e(ji,nlcj-nbghostcells:nlcj) = hbdy_n(ji) 564 563 END DO 565 564 ENDIF … … 601 600 INTEGER :: ji, jj, jk, jn ! dummy loop indices 602 601 INTEGER :: imin, imax, jmin, jmax 603 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 604 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 602 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 605 603 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 604 !!---------------------------------------------------------------------- … … 610 608 ELSE 611 609 ! 612 western_side = (nb == 1).AND.(ndir == 1) 613 eastern_side = (nb == 1).AND.(ndir == 2) 614 southern_side = (nb == 2).AND.(ndir == 1) 615 northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 ! 619 zalpha1 = ( zrhox - 1. ) * 0.5 620 zalpha2 = 1. - zalpha1 621 ! 622 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 623 zalpha4 = 1. - zalpha3 624 ! 625 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 626 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 627 zalpha5 = 1. - zalpha6 - zalpha7 628 ! 629 imin = i1 630 imax = i2 631 jmin = j1 632 jmax = j2 633 ! 634 ! Remove CORNERS 635 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 636 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 637 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 638 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 639 ! 640 IF( eastern_side ) THEN 641 DO jn = 1, jpts 642 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 643 DO jk = 1, jpkm1 644 DO jj = jmin,jmax 645 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 647 ELSE 648 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 649 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 650 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 651 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 610 IF( nbghostcells > 1 ) THEN ! no smoothing 611 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 612 ELSE ! smoothing 613 ! 614 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 615 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 z1 = ( zrhox - 1. ) * 0.5 619 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 620 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 621 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 622 ! 623 z2 = 1. - z1 624 z4 = 1. - z3 625 z5 = 1. - z6 - z7 626 ! 627 imin = i1 ; imax = i2 628 jmin = j1 ; jmax = j2 629 ! 630 ! Remove CORNERS 631 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 632 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 633 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 634 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 635 ! 636 IF( eastern_side ) THEN 637 DO jn = 1, jpts 638 tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 639 DO jk = 1, jpkm1 640 DO jj = jmin,jmax 641 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 642 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 643 ELSE 644 tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 645 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 647 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 648 ENDIF 652 649 ENDIF 653 END IF650 END DO 654 651 END DO 655 END DO656 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp657 END DO658 ENDIF659 !660 IF( northern_side ) THEN661 DO jn = 1, jpts662 tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)663 DO jk = 1, jpkm1664 DO ji = imin,imax665 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN666 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)667 ELSE668 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)669 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN670 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) &671 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)652 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 653 END DO 654 ENDIF 655 ! 656 IF( northern_side ) THEN 657 DO jn = 1, jpts 658 tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 659 DO jk = 1, jpkm1 660 DO ji = imin,imax 661 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 662 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 663 ELSE 664 tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 665 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 666 tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) & 667 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 668 ENDIF 672 669 ENDIF 673 END IF670 END DO 674 671 END DO 675 END DO676 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp677 END DO678 ENDIF679 !680 IF( western_side ) THEN681 DO jn = 1, jpts682 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)683 DO jk = 1, jpkm1684 DO jj = jmin,jmax685 IF( umask(2,jj,jk) == 0._wp ) THEN686 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)687 ELSE688 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)689 IF( un(2,jj,jk) < 0._wp ) THEN690 tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)672 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 673 END DO 674 ENDIF 675 ! 676 IF( western_side ) THEN 677 DO jn = 1, jpts 678 tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 679 DO jk = 1, jpkm1 680 DO jj = jmin,jmax 681 IF( umask(2,jj,jk) == 0._wp ) THEN 682 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 683 ELSE 684 tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 685 IF( un(2,jj,jk) < 0._wp ) THEN 686 tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 687 ENDIF 691 688 ENDIF 692 END IF689 END DO 693 690 END DO 694 END DO695 tsa(1,j1:j2,k1:k2,jn) = 0._wp696 END DO697 ENDIF698 !699 IF( southern_side ) THEN700 DO jn = 1, jpts701 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)702 DO jk = 1, jpk703 DO ji=imin,imax704 IF( vmask(ji,2,jk) == 0._wp ) THEN705 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)706 ELSE707 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)708 IF( vn(ji,2,jk) < 0._wp ) THEN709 tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)691 tsa(1,j1:j2,k1:k2,jn) = 0._wp 692 END DO 693 ENDIF 694 ! 695 IF( southern_side ) THEN 696 DO jn = 1, jpts 697 tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 698 DO jk = 1, jpk 699 DO ji=imin,imax 700 IF( vmask(ji,2,jk) == 0._wp ) THEN 701 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 702 ELSE 703 tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 704 IF( vn(ji,2,jk) < 0._wp ) THEN 705 tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 706 ENDIF 710 707 ENDIF 711 END IF708 END DO 712 709 END DO 713 END DO 714 tsa(i1:i2,1,k1:k2,jn) = 0._wp 715 END DO 716 ENDIF 717 ! 718 ! Treatment of corners 719 ! 720 ! East south 721 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 722 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 723 ENDIF 724 ! East north 725 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 726 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 727 ENDIF 728 ! West south 729 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 730 tsa(2,2,:,:) = ptab(2,2,:,:) 731 ENDIF 732 ! West north 733 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 734 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 735 ENDIF 736 ! 710 tsa(i1:i2,1,k1:k2,jn) = 0._wp 711 END DO 712 ENDIF 713 ! 714 ! Treatment of corners 715 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 716 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 717 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(2,2,:,:) = ptab(2,2,:,:) ! West south 718 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 719 ! 720 ENDIF 737 721 ENDIF 738 722 ! … … 759 743 southern_side = (nb == 2).AND.(ndir == 1) 760 744 northern_side = (nb == 2).AND.(ndir == 2) 761 IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 762 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 763 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 764 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 745 !! clem ghost 746 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i1,j1:j2,1) 747 IF(eastern_side) hbdy_e(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) !clem previously i1 748 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 749 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j1,1) 765 750 ENDIF 766 751 ! … … 854 839 ELSEIF( bdy_tinterp == 2 ) THEN 855 840 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 856 & - zt0 * ( zt0 - 1._wp)**2._wp ) 857 841 & - zt0 * ( zt0 - 1._wp)**2._wp ) 858 842 ELSE 859 843 ztcoeff = 1 860 844 ENDIF 861 ! 862 IF(western_side) THEN 863 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 864 ENDIF 865 IF(eastern_side) THEN 866 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 867 ENDIF 868 IF(southern_side) THEN 869 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 870 ENDIF 871 IF(northern_side) THEN 872 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 873 ENDIF 845 !! clem ghost 846 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 847 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1 848 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 849 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 874 850 ! 875 851 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 876 IF(western_side) THEN 877 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 878 ENDIF 879 IF(eastern_side) THEN 880 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 881 ENDIF 882 IF(southern_side) THEN 883 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 884 ENDIF 885 IF(northern_side) THEN 886 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 887 ENDIF 852 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 853 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 854 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 855 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 888 856 ENDIF 889 857 ENDIF … … 927 895 ztcoeff = 1 928 896 ENDIF 929 ! 930 IF(western_side) THEN 931 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 932 ENDIF 933 IF(eastern_side) THEN 934 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 935 ENDIF 936 IF(southern_side) THEN 937 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 938 ENDIF 939 IF(northern_side) THEN 940 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 941 ENDIF 897 !! clem ghost 898 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 899 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1 900 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 901 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 942 902 ! 943 903 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 944 IF(western_side) THEN 945 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 946 & * vmask(i1,j1:j2,1) 947 ENDIF 948 IF(eastern_side) THEN 949 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 950 & * vmask(i1,j1:j2,1) 951 ENDIF 952 IF(southern_side) THEN 953 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 954 & * vmask(i1:i2,j1,1) 955 ENDIF 956 IF(northern_side) THEN 957 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 958 & * vmask(i1:i2,j1,1) 959 ENDIF 904 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 905 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 906 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 907 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 960 908 ENDIF 961 909 ENDIF … … 991 939 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 992 940 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 993 ! 941 !! clem ghost 994 942 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) 995 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i 1,j1:j2)996 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j 1)943 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1 944 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 997 945 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 998 946 ENDIF … … 1031 979 ! 1032 980 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1033 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i 1,j1:j2)1034 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j 1)981 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1 982 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 1035 983 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 984 ENDIF … … 1050 998 INTEGER :: ji, jj, jk 1051 999 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1052 REAL(wp) :: ztmpmsk1053 1000 !!---------------------------------------------------------------------- 1054 1001 ! … … 1060 1007 southern_side = (nb == 2).AND.(ndir == 1) 1061 1008 northern_side = (nb == 2).AND.(ndir == 2) 1062 1009 ! 1063 1010 DO jk = k1, k2 1064 1011 DO jj = j1, j2 1065 1012 DO ji = i1, i2 1066 ! Get velocity mask at boundary edge points:1067 IF( western_side ) ztmpmsk = umask(ji ,jj ,1)1068 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1)1069 IF( northern_side) ztmpmsk = vmask(ji ,nlcj-2,1)1070 IF( southern_side) ztmpmsk = vmask(ji ,2 ,1)1071 1013 ! 1072 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) *ztmpmsk> 1.D-2) THEN1014 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1073 1015 IF (western_side) THEN 1074 1016 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r7646 r8129 34 34 !! *** ROUTINE Agrif_Sponge_Tra *** 35 35 !!--------------------------------------------- 36 REAL(wp) :: timecoeff36 REAL(wp) :: zcoef 37 37 !!--------------------------------------------- 38 38 ! 39 39 #if defined SPONGE 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()40 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 41 41 42 42 CALL Agrif_Sponge … … 45 45 tabspongedone_tsn = .FALSE. 46 46 47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight= timecoeff,procname=interptsn_sponge)47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 48 48 49 49 Agrif_UseSpecialValue = .FALSE. … … 57 57 !! *** ROUTINE Agrif_Sponge_dyn *** 58 58 !!--------------------------------------------- 59 REAL(wp) :: timecoeff59 REAL(wp) :: zcoef 60 60 !!--------------------------------------------- 61 61 62 62 #if defined SPONGE 63 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()63 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 64 64 65 65 Agrif_SpecialValue=0. … … 68 68 tabspongedone_u = .FALSE. 69 69 tabspongedone_v = .FALSE. 70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight= timecoeff,procname=interpun_sponge)70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 71 71 72 72 tabspongedone_u = .FALSE. 73 73 tabspongedone_v = .FALSE. 74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight= timecoeff,procname=interpvn_sponge)74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 75 75 76 76 Agrif_UseSpecialValue = .FALSE. … … 84 84 !! *** ROUTINE Agrif_Sponge *** 85 85 !!--------------------------------------------- 86 INTEGER :: ji,jj,jk 87 INTEGER :: ispongearea, ilci, ilcj 88 LOGICAL :: ll_spdone 89 REAL(wp) :: z1spongearea, zramp 90 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 86 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 87 ! 88 INTEGER :: ji, jj, ind1, ind2 89 INTEGER :: ispongearea 90 REAL(wp) :: z1_spongearea 91 !!--------------------------------------------- 91 92 92 93 #if defined SPONGE || defined SPONGE_TOP 93 ll_spdone=.TRUE.94 94 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 95 ! Define ramp from boundaries towards domain interior 96 ! at T-points 95 ! Define ramp from boundaries towards domain interior at T-points 97 96 ! Store it in ztabramp 98 ll_spdone=.FALSE.99 100 CALL wrk_alloc( jpi, jpj, ztabramp )101 97 102 98 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 103 ilci = nlci - ispongearea 104 ilcj = nlcj - ispongearea 105 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 106 99 z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 100 107 101 ztabramp(:,:) = 0._wp 108 102 103 ! --- West --- ! 109 104 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 105 ind1 = 1+nbghostcells 106 ind2 = 1+nbghostcells + (ispongearea-1) 110 107 DO jj = 1, jpj 111 IF ( umask(2,jj,1) == 1._wp ) THEN 112 DO ji = 2, ispongearea 113 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 114 END DO 115 ENDIF 108 DO ji = ind1, ind2 109 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 110 END DO 116 111 ENDDO 117 112 ENDIF 118 113 114 ! --- East --- ! 119 115 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 116 ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 117 ind2 = nlci - (1+nbghostcells) 120 118 DO jj = 1, jpj 121 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 122 DO ji = ilci+1,nlci-1 123 zramp = (ji - (ilci+1) ) * z1spongearea 124 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 125 ENDDO 126 ENDIF 119 DO ji = ind1, ind2 120 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 121 ENDDO 127 122 ENDDO 128 123 ENDIF 129 124 125 ! --- South --- ! 130 126 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 131 DO ji = 1, jpi 132 IF ( vmask(ji,2,1) == 1._wp ) THEN 133 DO jj = 2, ispongearea 134 zramp = ( ispongearea-jj ) * z1spongearea 135 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 136 END DO 137 ENDIF 127 ind1 = 1+nbghostcells 128 ind2 = 1+nbghostcells + (ispongearea-1) 129 DO jj = ind1, ind2 130 DO ji = 1, jpi 131 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 132 END DO 138 133 ENDDO 139 134 ENDIF 140 135 136 ! --- North --- ! 141 137 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 142 DO ji = 1, jpi 143 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 144 DO jj = ilcj+1,nlcj-1 145 zramp = (jj - (ilcj+1) ) * z1spongearea 146 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 147 END DO 148 ENDIF 138 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 139 ind2 = nlcj - (1+nbghostcells) 140 DO jj = ind1, ind2 141 DO ji = 1, jpi 142 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 143 END DO 149 144 ENDDO 150 145 ENDIF … … 158 153 DO jj = 2, jpjm1 159 154 DO ji = 2, jpim1 ! vector opt. 160 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj )) 161 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji ,jj+1)) 162 END DO 163 END DO 164 155 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 156 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 157 END DO 158 END DO 165 159 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 166 160 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 161 167 162 spongedoneT = .TRUE. 168 163 ENDIF … … 179 174 END DO 180 175 END DO 181 182 176 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 183 177 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 178 184 179 spongedoneU = .TRUE. 185 180 ENDIF 186 !187 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )188 181 ! 189 182 #endif … … 205 198 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 206 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 !!--------------------------------------------- 207 201 ! 208 202 IF( before ) THEN … … 327 321 328 322 jmax = j2-1 329 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj- 3)323 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 330 324 331 325 DO jj = j1+1, jmax … … 404 398 405 399 imax = i2-1 406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci- 3)400 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 407 401 408 402 DO jj = j1+1, j2 -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r6140 r8129 50 50 ! 51 51 INTEGER :: ji, jj, jk, jn ! dummy loop indices 52 INTEGER ::imin, imax, jmin, jmax53 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha354 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha755 LOGICAL :: western_side, eastern_side,northern_side,southern_side56 52 INTEGER :: imin, imax, jmin, jmax 53 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 54 LOGICAL :: western_side, eastern_side,northern_side,southern_side 55 !!----------------------------------------------------------------------- 56 ! 57 57 IF (before) THEN 58 58 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 59 59 ELSE 60 60 ! 61 western_side = (nb == 1).AND.(ndir == 1) 62 eastern_side = (nb == 1).AND.(ndir == 2) 63 southern_side = (nb == 2).AND.(ndir == 1) 64 northern_side = (nb == 2).AND.(ndir == 2) 65 ! 66 zrhox = Agrif_Rhox() 67 ! 68 zalpha1 = ( zrhox - 1. ) * 0.5 69 zalpha2 = 1. - zalpha1 70 ! 71 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 72 zalpha4 = 1. - zalpha3 73 ! 74 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 75 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 76 zalpha5 = 1. - zalpha6 - zalpha7 77 ! 78 imin = i1 79 imax = i2 80 jmin = j1 81 jmax = j2 82 ! 83 ! Remove CORNERS 84 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 85 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 86 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 87 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 88 ! 89 IF( eastern_side) THEN 90 DO jn = 1, jptra 91 tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 92 DO jk = 1, jpkm1 93 DO jj = jmin,jmax 94 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 95 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 96 ELSE 97 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 98 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 99 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 100 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 61 IF( nbghostcells > 1 ) THEN ! no smoothing 62 tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 63 ELSE ! smoothing 64 ! 65 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 66 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 67 ! 68 zrhox = Agrif_Rhox() 69 z1 = ( zrhox - 1. ) * 0.5 70 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 71 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 72 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 73 ! 74 z2 = 1. - z1 75 z4 = 1. - z3 76 z5 = 1. - z6 - z7 77 ! 78 imin = i1 ; imax = i2 79 jmin = j1 ; jmax = j2 80 ! 81 ! Remove CORNERS 82 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 83 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 84 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 85 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 86 ! 87 IF( eastern_side) THEN 88 DO jn = 1, jptra 89 tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 90 DO jk = 1, jpkm1 91 DO jj = jmin,jmax 92 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 93 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 94 ELSE 95 tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 96 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 97 tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 98 + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 99 ENDIF 101 100 ENDIF 102 ENDIF 101 END DO 102 END DO 103 ENDDO 104 ENDIF 105 ! 106 IF( northern_side ) THEN 107 DO jn = 1, jptra 108 tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 109 DO jk = 1, jpkm1 110 DO ji = imin,imax 111 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 112 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 113 ELSE 114 tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 115 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 116 tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn) & 117 + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 118 ENDIF 119 ENDIF 120 END DO 121 END DO 122 ENDDO 123 ENDIF 124 ! 125 IF( western_side) THEN 126 DO jn = 1, jptra 127 tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 128 DO jk = 1, jpkm1 129 DO jj = jmin,jmax 130 IF( umask(2,jj,jk) == 0.e0 ) THEN 131 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 132 ELSE 133 tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 134 IF( un(2,jj,jk) < 0.e0 ) THEN 135 tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 136 ENDIF 137 ENDIF 138 END DO 103 139 END DO 104 140 END DO 105 ENDDO 141 ENDIF 142 ! 143 IF( southern_side ) THEN 144 DO jn = 1, jptra 145 tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 146 DO jk=1,jpk 147 DO ji=imin,imax 148 IF( vmask(ji,2,jk) == 0.e0 ) THEN 149 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 150 ELSE 151 tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 152 IF( vn(ji,2,jk) < 0.e0 ) THEN 153 tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 154 ENDIF 155 ENDIF 156 END DO 157 END DO 158 ENDDO 159 ENDIF 160 ! 161 ! Treatment of corners 162 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 163 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 164 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(2,2,:,:) = ptab(2,2,:,:) ! West south 165 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 166 ! 106 167 ENDIF 107 !108 IF( northern_side ) THEN109 DO jn = 1, jptra110 tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)111 DO jk = 1, jpkm1112 DO ji = imin,imax113 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN114 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)115 ELSE116 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)117 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN118 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) &119 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)120 ENDIF121 ENDIF122 END DO123 END DO124 ENDDO125 ENDIF126 !127 IF( western_side) THEN128 DO jn = 1, jptra129 tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)130 DO jk = 1, jpkm1131 DO jj = jmin,jmax132 IF( umask(2,jj,jk) == 0.e0 ) THEN133 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)134 ELSE135 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)136 IF( un(2,jj,jk) < 0.e0 ) THEN137 tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)138 ENDIF139 ENDIF140 END DO141 END DO142 END DO143 ENDIF144 !145 IF( southern_side ) THEN146 DO jn = 1, jptra147 tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)148 DO jk=1,jpk149 DO ji=imin,imax150 IF( vmask(ji,2,jk) == 0.e0 ) THEN151 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)152 ELSE153 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)154 IF( vn(ji,2,jk) < 0.e0 ) THEN155 tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)156 ENDIF157 ENDIF158 END DO159 END DO160 ENDDO161 ENDIF162 !163 ! Treatment of corners164 !165 ! East south166 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN167 tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)168 ENDIF169 ! East north170 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN171 tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)172 ENDIF173 ! West south174 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN175 tra(2,2,:,:) = ptab(2,2,:,:)176 ENDIF177 ! West north178 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN179 tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)180 ENDIF181 !182 168 ENDIF 183 169 ! -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7761 r8129 127 127 !! 128 128 IMPLICIT NONE 129 ! 130 INTEGER :: ind1, ind2, ind3 129 131 !!---------------------------------------------------------------------- 130 132 131 133 ! 1. Declaration of the type of variable which have to be interpolated 132 134 !--------------------------------------------------------------------- 133 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 134 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 135 !!clem ghost 136 ind1 = nbghostcells 137 ind2 = 1 + nbghostcells 138 ind3 = 2 + nbghostcells 139 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 140 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 141 !!clem ghost 135 142 136 143 ! 2. Type of interpolation … … 141 148 ! 3. Location of interpolation 142 149 !----------------------------- 143 CALL Agrif_Set_bc(e1u_id,(/0,0/)) 144 CALL Agrif_Set_bc(e2v_id,(/0,0/)) 150 !!clem ghost (previously set to /0,0/) 151 CALL Agrif_Set_bc(e1u_id,(/0,ind1/)) 152 CALL Agrif_Set_bc(e2v_id,(/0,ind1/)) 153 !!clem ghost 145 154 146 155 ! 5. Update type … … 337 346 !!---------------------------------------------------------------------- 338 347 USE agrif_util 339 USE par_oce ! ONLY : jpts 348 USE par_oce ! ONLY : jpts and ghostcells 340 349 USE oce 341 350 USE agrif_oce 342 351 !! 343 352 IMPLICIT NONE 353 ! 354 INTEGER :: ind1, ind2, ind3 344 355 !!---------------------------------------------------------------------- 345 356 346 357 ! 1. Declaration of the type of variable which have to be interpolated 347 358 !--------------------------------------------------------------------- 348 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 349 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 350 351 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 352 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 353 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 354 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 355 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 356 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 357 358 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 359 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 360 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 361 362 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 363 364 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 365 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 366 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 367 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 368 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 369 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 370 371 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 359 !!clem ghost 360 ind1 = nbghostcells 361 ind2 = 1 + nbghostcells 362 ind3 = 2 + nbghostcells 363 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 364 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 365 366 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 367 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 368 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 369 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 370 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 371 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 372 373 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 374 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 375 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 376 377 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 378 379 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 380 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 381 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 382 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 383 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 384 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 385 386 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 372 387 373 388 # if defined key_zdftke 374 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)375 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)376 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)389 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 390 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 391 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 377 392 # endif 393 !!clem ghost 378 394 379 395 ! 2. Type of interpolation … … 407 423 ! 3. Location of interpolation 408 424 !----------------------------- 409 CALL Agrif_Set_bc(tsn_id,(/0,1/)) 410 CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 411 CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 412 413 ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 414 ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 415 ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 416 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 425 !!clem ghost 426 CALL Agrif_Set_bc(tsn_id,(/0,ind1/)) 427 CALL Agrif_Set_bc(un_interp_id,(/0,ind1/)) 428 CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/)) 429 430 ! clem: previously set to /-,0/ 431 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 417 432 CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 418 433 CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 419 434 420 CALL Agrif_Set_bc(sshn_id,(/0,0/)) 421 CALL Agrif_Set_bc(unb_id ,(/0,0/)) 422 CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 423 CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 424 CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 425 426 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9 427 CALL Agrif_Set_bc(umsk_id,(/0,0/)) 428 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 429 435 CALL Agrif_Set_bc(sshn_id,(/0,ind1/)) 436 CALL Agrif_Set_bc(unb_id ,(/0,ind1/)) 437 CALL Agrif_Set_bc(vnb_id ,(/0,ind1/)) 438 CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1/)) 439 CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1/)) 440 441 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1/)) ! if west and rhox=3 and ghost=1: column 1 to 9 442 CALL Agrif_Set_bc(umsk_id,(/0,ind1/)) 443 CALL Agrif_Set_bc(vmsk_id,(/0,ind1/)) 444 445 ! clem: previously set to /0,1/ 430 446 # if defined key_zdftke 431 CALL Agrif_Set_bc(avm_id ,(/0, 1/))447 CALL Agrif_Set_bc(avm_id ,(/0,ind1/)) 432 448 # endif 449 !!clem ghost 433 450 434 451 ! 5. Update type … … 623 640 USE Agrif_Util 624 641 USE ice 625 626 IMPLICIT NONE 642 USE par_oce, ONLY : nbghostcells 643 ! 644 IMPLICIT NONE 645 ! 646 INTEGER :: ind1, ind2, ind3 627 647 !!---------------------------------------------------------------------- 628 648 ! … … 634 654 ! 2,2 = two ghost lines 635 655 !------------------------------------------------------------------------------------- 636 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 637 CALL agrif_declare_variable((/1,2/) ,(/2,3/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 638 CALL agrif_declare_variable((/2,1/) ,(/3,2/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 656 !!clem ghost 657 ind1 = nbghostcells 658 ind2 = 1 + nbghostcells 659 ind3 = 2 + nbghostcells 660 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 661 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 662 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 663 !!clem ghost 639 664 640 665 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 646 671 ! 3. Set location of interpolations 647 672 !---------------------------------- 648 CALL Agrif_Set_bc(tra_ice_id,(/0,1/)) 649 CALL Agrif_Set_bc(u_ice_id ,(/0,1/)) 650 CALL Agrif_Set_bc(v_ice_id ,(/0,1/)) 673 !!clem ghost 674 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 675 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 676 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 677 !!clem ghost 651 678 652 679 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 777 804 !! 778 805 IMPLICIT NONE 806 ! 807 INTEGER :: ind1, ind2, ind3 779 808 !!---------------------------------------------------------------------- 780 809 781 810 ! 1. Declaration of the type of variable which have to be interpolated 782 811 !--------------------------------------------------------------------- 783 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 784 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 812 !!clem ghost 813 ind1 = nbghostcells 814 ind2 = 1 + nbghostcells 815 ind3 = 2 + nbghostcells 816 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 817 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 785 818 786 819 ! 2. Type of interpolation … … 791 824 ! 3. Location of interpolation 792 825 !----------------------------- 793 CALL Agrif_Set_bc(trn_id,(/0,1/)) 794 ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 795 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 826 !!clem ghost 827 CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 828 !clem: previously set to /-,0/ 829 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,ind1/)) 796 830 797 831 ! 5. Update type -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7753 r8129 1012 1012 CALL lim_wri_state_2( kt, id_i, nh_i ) 1013 1013 #elif defined key_lim3 1014 CALL lim_wri_state( kt, id_i, nh_i ) 1014 IF( nn_ice == 3 ) THEN ! clem2017: condition in case agrif + lim but no-ice in child grid 1015 CALL lim_wri_state( kt, id_i, nh_i ) 1016 ENDIF 1015 1017 #else 1016 1018 CALL histend( id_i, snc4chunks=snc4set ) -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r7646 r8129 116 116 END TYPE WGT 117 117 118 INTEGER, PARAMETER :: tot_wgts = 10118 INTEGER, PARAMETER :: tot_wgts = 20 119 119 TYPE( WGT ), DIMENSION(tot_wgts) :: ref_wgts ! array of wgts 120 120 INTEGER :: nxt_wgt = 1 ! point to next available space in ref_wgts array -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7822 r8129 328 328 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 329 329 ! 330 IF( ln_isf ) CALL sbc_isf_init 330 IF( ln_isf ) CALL sbc_isf_init ! Compute iceshelves 331 331 ! 332 332 CALL sbc_rnf_init ! Runof initialization 333 333 ! 334 IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialization 335 ! 336 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialization 334 IF ( lk_agrif .AND. nn_ice == 0 ) THEN 335 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' ) ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid 336 ELSEIF( nn_ice == 3 ) THEN ; CALL sbc_lim_init ! LIM3 initialization 337 ELSEIF( nn_ice == 4 ) THEN ; CALL cice_sbc_init( nsbc ) ! CICE initialization 338 ENDIF 337 339 ! 338 340 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7761 r8129 206 206 ! 207 207 #if defined key_agrif 208 IF( .NOT. Agrif_Root() ) THEN208 !!clem2017 IF( .NOT. Agrif_Root() ) THEN 209 209 CALL Agrif_ParentGrid_To_ChildGrid() 210 210 IF( ln_diaobs ) CALL dia_obs_wri 211 211 IF( nn_timing == 1 ) CALL timing_finalize 212 212 CALL Agrif_ChildGrid_To_ParentGrid() 213 ENDIF213 !!clem2017 ENDIF 214 214 #endif 215 215 IF( nn_timing == 1 ) CALL timing_finalize -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r7761 r8129 400 400 CALL lim_wri_state_2( kt, id_i, nh_i ) 401 401 #elif defined key_lim3 402 CALL lim_wri_state( kt, id_i, nh_i ) 402 IF( nn_ice == 3 ) THEN ! clem2017: condition in case agrif + lim but no-ice in child grid 403 CALL lim_wri_state( kt, id_i, nh_i ) 404 ENDIF 403 405 #else 404 406 CALL histend( id_i, snc4chunks=snc4set ) -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7761 r8129 134 134 ! 135 135 #if defined key_agrif 136 IF( .NOT. Agrif_Root() ) THEN136 !!clem2017 IF( .NOT. Agrif_Root() ) THEN 137 137 CALL Agrif_ParentGrid_To_ChildGrid() 138 138 IF( nn_timing == 1 ) CALL timing_finalize 139 139 CALL Agrif_ChildGrid_To_ParentGrid() 140 ENDIF140 !!clem2017 ENDIF 141 141 #endif 142 142 IF( nn_timing == 1 ) CALL timing_finalize
Note: See TracChangeset
for help on using the changeset viewer.