- Timestamp:
- 2020-06-03T16:30:02+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90
r12489 r13026 28 28 ! 29 29 ! !* Agrif initialization 30 CALL agrif_nemo_init31 CALL Agrif_InitValues_cont_dom32 30 CALL Agrif_InitValues_cont 33 31 # if defined key_top … … 40 38 END SUBROUTINE Agrif_initvalues 41 39 42 SUBROUTINE Agrif_InitValues_cont_dom 43 !!---------------------------------------------------------------------- 44 !! *** ROUTINE Agrif_InitValues_cont_dom *** 45 !!---------------------------------------------------------------------- 46 ! 47 CALL agrif_declare_var_dom 48 ! 49 END SUBROUTINE Agrif_InitValues_cont_dom 50 51 SUBROUTINE agrif_declare_var_dom 52 !!---------------------------------------------------------------------- 53 !! *** ROUTINE agrif_declare_var_dom *** 54 !!---------------------------------------------------------------------- 55 USE par_oce, ONLY: nbghostcells 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 51 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 52 INTEGER :: jn 53 54 l_ini_child = .TRUE. 55 Agrif_SpecialValue = 0._wp 56 Agrif_UseSpecialValue = .TRUE. 57 uu(:,:,:,:) = 0. ; vv(:,:,:,:) = 0. ; ts(:,:,:,:,:) = 0. 58 59 Krhs_a = Kbb ; Kmm_a = Kbb 60 61 ! Brutal fix to pas 1x1 refinment. 62 ! IF(Agrif_Irhox() == 1) THEN 63 CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 64 ! ELSE 65 ! CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 66 67 ! ENDIF 68 Agrif_UseSpecialValue = ln_spc_dyn 69 use_sign_north = .TRUE. 70 sign_north = -1. 71 ! CALL Agrif_Init_Variable(uini_id , procname=interpun ) 72 ! CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 73 use_sign_north = .FALSE. 74 75 Agrif_UseSpecialValue = .FALSE. ! 76 l_ini_child = .FALSE. 77 Krhs_a = Kaa ; Kmm_a = Kmm 78 79 DO jn = 1, jpts 80 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 81 END DO 82 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 83 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 84 85 86 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 87 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 88 89 END SUBROUTINE agrif_istate 90 91 SUBROUTINE agrif_declare_var_ini 92 !!---------------------------------------------------------------------- 93 !! *** ROUTINE agrif_declare_var *** 94 !!---------------------------------------------------------------------- 95 USE agrif_util 96 USE agrif_oce 97 USE par_oce 98 USE zdf_oce 99 USE oce 100 USE dom_oce 56 101 ! 57 102 IMPLICIT NONE 58 103 ! 59 104 INTEGER :: ind1, ind2, ind3 60 !!---------------------------------------------------------------------- 105 External :: nemo_mapping 106 !!---------------------------------------------------------------------- 107 108 ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 109 ! The procnames will not be called at these boundaries 110 IF (jperio == 1) THEN 111 CALL Agrif_Set_NearCommonBorderX(.TRUE.) 112 CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 113 ENDIF 114 115 IF ( .NOT. ln_bry_south) THEN 116 CALL Agrif_Set_NearCommonBorderY(.TRUE.) 117 ENDIF 61 118 62 119 ! 1. Declaration of the type of variable which have to be interpolated 63 120 !--------------------------------------------------------------------- 64 121 ind1 = nbghostcells 65 ind2 = 1 + nbghostcells 66 ind3 = 2 + nbghostcells 67 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 68 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 69 122 ind2 = 2 + nbghostcells_x 123 ind3 = 2 + nbghostcells_y_s 124 125 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 126 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 127 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 128 129 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 130 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 131 132 133 ! Initial or restart velues 134 CALL Agrif_Set_MaskMaxSearch(25) 135 ! 136 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsini_id) 137 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/) ,uini_id ) 138 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/) ,vini_id ) 139 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id) 140 ! 141 CALL Agrif_Set_MaskMaxSearch(5) 142 70 143 ! 2. Type of interpolation 71 144 !------------------------- 145 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 146 147 CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 148 CALL Agrif_Set_interp (mbkt_id,interp=AGRIF_constant) 149 CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 150 CALL Agrif_Set_interp (ht0_id ,interp=AGRIF_constant) 151 72 152 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm ) 73 153 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear ) 74 154 75 ! 3. Location of interpolation 155 ! Initial fields 156 CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 157 CALL Agrif_Set_interp (tsini_id ,interp=AGRIF_linear) 158 CALL Agrif_Set_bcinterp(uini_id ,interp=AGRIF_linear) 159 CALL Agrif_Set_interp (uini_id ,interp=AGRIF_linear) 160 CALL Agrif_Set_bcinterp(vini_id ,interp=AGRIF_linear) 161 CALL Agrif_Set_interp (vini_id ,interp=AGRIF_linear) 162 CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 163 CALL Agrif_Set_interp (sshini_id,interp=AGRIF_linear) 164 165 ! 3. Location of interpolation 76 166 !----------------------------- 167 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 168 ! JC: check near the boundary only until matching in sponge has been sorted out: 169 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 170 171 ! extend the interpolation zone by 1 more point than necessary: 172 ! RB check here 173 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 174 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 175 77 176 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 78 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 177 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 178 179 CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 180 CALL Agrif_Set_bc( uini_id , (/0,ind1-1/) ) 181 CALL Agrif_Set_bc( vini_id , (/0,ind1-1/) ) 182 CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 79 183 80 184 ! 4. Update type … … 87 191 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 88 192 #endif 89 90 END SUBROUTINE agrif_declare_var_dom 91 92 SUBROUTINE Agrif_InitValues_cont 93 !!---------------------------------------------------------------------- 94 !! *** ROUTINE Agrif_InitValues_cont *** 95 !!---------------------------------------------------------------------- 96 USE agrif_oce 193 194 CALL Agrif_Set_ExternalMapping(nemo_mapping) 195 ! 196 END SUBROUTINE agrif_declare_var_ini 197 198 199 SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 200 !!---------------------------------------------------------------------- 201 !! *** ROUTINE Agrif_InitValues_cont_dom *** 202 !!---------------------------------------------------------------------- 203 204 !!---------------------------------------------------------------------- 205 !! *** ROUTINE Agrif_InitValues_cont *** 206 !! 207 !! ** Purpose :: Declaration of variables to be interpolated 208 !!---------------------------------------------------------------------- 209 USE agrif_oce_update 97 210 USE agrif_oce_interp 98 211 USE agrif_oce_sponge 212 USE Agrif_Util 213 USE oce 99 214 USE dom_oce 100 USE oce 215 USE zdf_oce 216 USE nemogcm 217 USE agrif_oce 218 ! 219 USE lbclnk 101 220 USE lib_mpp 102 USE lbclnk221 USE in_out_manager 103 222 ! 104 223 IMPLICIT NONE 105 224 ! 106 INTEGER :: ji, jj 225 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 226 ! 107 227 LOGICAL :: check_namelist 108 228 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 109 #if defined key_vertical110 229 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 111 #endif 112 !!---------------------------------------------------------------------- 113 114 ! 1. Declaration of the type of variable which have to be interpolated 115 !--------------------------------------------------------------------- 116 CALL agrif_declare_var 117 118 ! 2. First interpolations of potentially non zero fields 119 !------------------------------------------------------- 120 121 #if defined key_vertical 230 INTEGER :: ji, jj, jk, iminspon 231 !!---------------------------------------------------------------------- 232 233 ! CALL Agrif_Declare_Var_ini 234 235 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 236 237 ! lk_west = ( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) 238 ! lk_east = ( ((nbondi == 1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) 239 ! lk_south = ( ((nbondj == -1) .OR. (nbondj == 2) ).AND. ln_bry_south) 240 ! lk_north = ( ((nbondj == 1) .OR. (nbondj == 2) )) 241 242 lk_west = ( .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) 243 lk_east = ( .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) 244 lk_south = ln_bry_south 245 lk_north = .true. 246 247 ! Check sponge length: 248 iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 249 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 250 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 251 122 252 ! Build consistent parent bathymetry and number of levels 123 253 ! on the child grid … … 126 256 mbkt_parent(:,:) = 0 127 257 ! 128 CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 129 CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 258 ! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 259 ! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 260 CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 261 CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 130 262 ! 131 263 ! Assume step wise change of bathymetry near interface … … 149 281 ENDIF 150 282 ! 151 CALL lbc_lnk( 'Agrif_Init Values_cont', hu0_parent, 'U', 1. )152 CALL lbc_lnk( 'Agrif_Init Values_cont', hv0_parent, 'V', 1. )283 CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 284 CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 153 285 zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 154 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 286 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 155 287 zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 156 288 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 157 #endif 158 289 290 291 CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 292 CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 293 DO jk = 1, jpk 294 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 295 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 296 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 297 END DO 298 299 ! check if masks and bathymetries match 300 IF(ln_chk_bathy) THEN 301 Agrif_UseSpecialValue = .FALSE. 302 ! 303 IF(lwp) WRITE(numout,*) ' ' 304 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 305 ! 306 kindic_agr = 0 307 IF( .NOT. l_vremap ) THEN 308 ! 309 ! check if tmask and vertical scale factors agree with parent in sponge area: 310 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 311 ! 312 ELSE 313 ! 314 ! In case of vertical interpolation, check only that total depths agree between child and parent: 315 DO ji = 1, jpi 316 DO jj = 1, jpj 317 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 318 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 319 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 320 END DO 321 END DO 322 323 CALL mpp_sum( 'agrif_user', kindic_agr ) 324 IF( kindic_agr /= 0 ) THEN 325 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 326 ELSE 327 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 328 IF(lwp) WRITE(numout,*) ' ' 329 ENDIF 330 ENDIF 331 ENDIF 332 333 IF( l_vremap ) THEN 334 ! Additional constrain that should be removed someday: 335 IF ( Agrif_Parent(jpk).GT.jpk ) THEN 336 CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 337 ENDIF 338 ENDIF 339 ! 340 END SUBROUTINE Agrif_Init_Domain 341 342 343 SUBROUTINE Agrif_InitValues_cont 344 !!---------------------------------------------------------------------- 345 !! *** ROUTINE Agrif_InitValues_cont *** 346 !! 347 !! ** Purpose :: Declaration of variables to be interpolated 348 !!---------------------------------------------------------------------- 349 USE agrif_oce_update 350 USE agrif_oce_interp 351 USE agrif_oce_sponge 352 USE Agrif_Util 353 USE oce 354 USE dom_oce 355 USE zdf_oce 356 USE nemogcm 357 USE agrif_oce 358 ! 359 USE lbclnk 360 USE lib_mpp 361 USE in_out_manager 362 ! 363 IMPLICIT NONE 364 ! 365 LOGICAL :: check_namelist 366 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 367 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 368 INTEGER :: ji, jj 369 370 ! 1. Declaration of the type of variable which have to be interpolated 371 !--------------------------------------------------------------------- 372 CALL agrif_declare_var 373 374 ! 2. First interpolations of potentially non zero fields 375 !------------------------------------------------------- 159 376 Agrif_SpecialValue = 0._wp 160 377 Agrif_UseSpecialValue = .TRUE. … … 163 380 tabspongedone_tsn = .FALSE. 164 381 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 165 ! reset ts (:,:,:,:,Krhs_a)to zero382 ! reset tsa to zero 166 383 ts(:,:,:,:,Krhs_a) = 0._wp 167 384 168 385 Agrif_UseSpecialValue = ln_spc_dyn 386 use_sign_north = .TRUE. 387 sign_north = -1. 169 388 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 170 389 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) … … 175 394 tabspongedone_v = .FALSE. 176 395 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 396 use_sign_north = .FALSE. 177 397 uu(:,:,:,Krhs_a) = 0._wp 178 398 vv(:,:,:,Krhs_a) = 0._wp … … 185 405 IF ( ln_dynspg_ts ) THEN 186 406 Agrif_UseSpecialValue = ln_spc_dyn 407 use_sign_north = .TRUE. 408 sign_north = -1. 187 409 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 188 410 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 189 411 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 190 412 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 413 use_sign_north = .FALSE. 191 414 ubdy(:,:) = 0._wp 192 415 vbdy(:,:) = 0._wp 193 416 ENDIF 194 195 Agrif_UseSpecialValue = .FALSE. 196 197 ! 3. Some controls 417 Agrif_UseSpecialValue = .FALSE. 418 198 419 !----------------- 199 420 check_namelist = .TRUE. 200 421 201 422 IF( check_namelist ) THEN 202 203 ! Check time steps204 IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN205 WRITE(cl_check1,*) NINT(Agrif_Parent(rn_Dt))206 WRITE(cl_check2,*) NINT(rn_Dt)207 WRITE(cl_check3,*) NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot())208 CALL ctl_stop( 'Incompatible time step between ocean grids', &209 & 'parent grid value : '//cl_check1 , &210 & 'child grid value : '//cl_check2 , &211 & 'value on child grid should be changed to : '//cl_check3 )212 ENDIF213 214 ! Check run length215 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &216 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN217 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1218 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()219 CALL ctl_warn( 'Incompatible run length between grids' , &220 & 'nit000 on fine grid will be changed to : '//cl_check1, &221 & 'nitend on fine grid will be changed to : '//cl_check2 )222 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1223 nitend = Agrif_Parent(nitend) *Agrif_IRhot()224 ENDIF225 226 423 ! Check free surface scheme 227 424 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& … … 251 448 STOP 252 449 ENDIF 253 254 ENDIF 255 256 ! check if masks and bathymetries match 257 IF(ln_chk_bathy) THEN 258 Agrif_UseSpecialValue = .FALSE. 259 ! 260 IF(lwp) WRITE(numout,*) ' ' 261 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 262 ! 263 kindic_agr = 0 264 # if ! defined key_vertical 265 ! 266 ! check if tmask and vertical scale factors agree with parent in sponge area: 267 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 268 ! 269 # else 270 ! 271 ! In case of vertical interpolation, check only that total depths agree between child and parent: 272 DO ji = 1, jpi 273 DO jj = 1, jpj 274 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 275 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 276 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 277 END DO 278 END DO 279 # endif 280 CALL mpp_sum( 'agrif_user', kindic_agr ) 281 IF( kindic_agr /= 0 ) THEN 282 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 283 ELSE 284 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 285 IF(lwp) WRITE(numout,*) ' ' 286 END IF 287 ! 288 ENDIF 289 290 # if defined key_vertical 291 ! Additional constrain that should be removed someday: 292 IF ( Agrif_Parent(jpk).GT.jpk ) THEN 293 CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 294 ENDIF 295 # endif 296 ! 450 ENDIF 451 297 452 END SUBROUTINE Agrif_InitValues_cont 298 453 … … 314 469 ! 1. Declaration of the type of variable which have to be interpolated 315 470 !--------------------------------------------------------------------- 471 316 472 ind1 = nbghostcells 317 ind2 = 1 + nbghostcells 318 ind3 = 2 + nbghostcells 473 ind2 = 2 + nbghostcells_x 474 ind3 = 2 + nbghostcells_y_s 475 319 476 # if defined key_vertical 320 477 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 321 478 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 322 479 323 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)324 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)325 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)326 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)327 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)328 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)480 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) ! 481 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 482 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 483 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 484 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 485 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 329 486 # else 330 487 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) 331 488 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) 332 489 333 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)334 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)335 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)336 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)337 CALL agrif_declare_variable((/1,2,0,0/),(/ind2 ,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)338 CALL agrif_declare_variable((/2,1,0,0/),(/ind 3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)490 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 491 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 492 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 493 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 494 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 495 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 339 496 # endif 340 341 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)342 343 # if defined key_vertical344 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)345 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)346 # endif347 348 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)349 497 350 498 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) … … 357 505 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 358 506 359 IF( ln_zdftke.OR.ln_zdfgls ) THEN 507 508 IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point 360 509 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 361 510 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) … … 366 515 # endif 367 516 ENDIF 368 517 369 518 ! 2. Type of interpolation 370 519 !------------------------- 371 520 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 372 373 521 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 374 522 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 375 523 376 524 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 525 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 526 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 377 527 378 528 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) … … 390 540 !< 391 541 392 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 393 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 394 395 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 396 397 # if defined key_vertical 398 CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 399 CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 400 # endif 401 402 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 403 404 ! 3. Location of interpolation 542 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 543 544 545 ! 3. Location of interpolation 405 546 !----------------------------- 406 547 CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 … … 418 559 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 419 560 420 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 421 ! JC: check near the boundary only until matching in sponge has been sorted out: 422 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 423 424 # if defined key_vertical 425 ! extend the interpolation zone by 1 more point than necessary: 426 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 427 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 428 # endif 429 430 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 561 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 431 562 432 563 ! 4. Update type 433 564 !--------------- 434 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)435 565 436 566 # if defined UPD_HIGH … … 444 574 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 445 575 446 IF( ln_zdftke.OR.ln_zdfgls ) THEN576 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 447 577 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 448 578 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 449 579 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 450 ENDIF580 ! ENDIF 451 581 452 582 #else … … 460 590 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 461 591 462 IF( ln_zdftke.OR.ln_zdfgls ) THEN592 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 463 593 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 464 594 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 465 595 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 466 ENDIF596 ! ENDIF 467 597 468 598 #endif … … 472 602 #if defined key_si3 473 603 SUBROUTINE Agrif_InitValues_cont_ice 474 !!----------------------------------------------------------------------475 !! *** ROUTINE Agrif_InitValues_cont_ice ***476 !!----------------------------------------------------------------------477 604 USE Agrif_Util 478 605 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc … … 482 609 USE agrif_ice_interp 483 610 USE lib_mpp 484 ! 485 IMPLICIT NONE 486 !!---------------------------------------------------------------------- 487 ! 488 ! Declaration of the type of variable which have to be interpolated (parent=>child) 489 !---------------------------------------------------------------------------------- 490 CALL agrif_declare_var_ice 611 !!---------------------------------------------------------------------- 612 !! *** ROUTINE Agrif_InitValues_cont_ice *** 613 !!---------------------------------------------------------------------- 491 614 492 615 ! Controls … … 495 618 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 496 619 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 497 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 620 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 498 621 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 499 622 … … 516 639 !! *** ROUTINE agrif_declare_var_ice *** 517 640 !!---------------------------------------------------------------------- 641 518 642 USE Agrif_Util 519 643 USE ice 520 USE par_oce, ONLY : nbghostcells 644 USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 521 645 ! 522 646 IMPLICIT NONE 523 647 ! 524 648 INTEGER :: ind1, ind2, ind3 525 !!----------------------------------------------------------------------649 !!---------------------------------------------------------------------- 526 650 ! 527 651 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) … … 532 656 ! 2,2 = two ghost lines 533 657 !------------------------------------------------------------------------------------- 658 534 659 ind1 = nbghostcells 535 ind2 = 1 + nbghostcells 536 ind3 = 2 + nbghostcells 537 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 538 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 539 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 660 ind2 = 2 + nbghostcells_x 661 ind3 = 2 + nbghostcells_y_s 662 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 663 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 664 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 665 666 CALL Agrif_Set_MaskMaxSearch(25) 667 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 668 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_iceini_id ) 669 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_iceini_id ) 670 CALL Agrif_Set_MaskMaxSearch(5) 540 671 541 672 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 545 676 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 546 677 678 CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear) 679 CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear) 680 CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear ) 681 CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear ) 682 CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear) 683 CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear) 684 547 685 ! 3. Set location of interpolations 548 686 !---------------------------------- … … 550 688 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 551 689 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 690 691 CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 692 CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/)) 693 CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/)) 552 694 553 695 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 557 699 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 558 700 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 559 # else701 # else 560 702 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 561 703 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 562 704 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 563 # endif705 # endif 564 706 565 707 END SUBROUTINE agrif_declare_var_ice … … 585 727 USE agrif_top_sponge 586 728 !! 587 IMPLICIT NONE 588 ! 589 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 590 LOGICAL :: check_namelist 591 !!---------------------------------------------------------------------- 592 593 ! 1. Declaration of the type of variable which have to be interpolated 594 !--------------------------------------------------------------------- 595 CALL agrif_declare_var_top 596 597 ! 2. First interpolations of potentially non zero fields 598 !------------------------------------------------------- 599 Agrif_SpecialValue=0._wp 600 Agrif_UseSpecialValue = .TRUE. 601 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 602 Agrif_UseSpecialValue = .FALSE. 603 CALL Agrif_Sponge 604 tabspongedone_trn = .FALSE. 605 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 606 ! reset ts(:,:,:,:,Krhs_a) to zero 607 tr(:,:,:,:,Krhs_a) = 0._wp 608 609 ! 3. Some controls 610 !----------------- 611 check_namelist = .TRUE. 612 613 IF( check_namelist ) THEN 614 ! Check time steps 615 IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 616 WRITE(cl_check1,*) Agrif_Parent(rn_Dt) 617 WRITE(cl_check2,*) rn_Dt 618 WRITE(cl_check3,*) rn_Dt*Agrif_Rhot() 729 730 !! 731 IMPLICIT NONE 732 ! 733 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 734 LOGICAL :: check_namelist 735 !!---------------------------------------------------------------------- 736 737 738 ! 1. Declaration of the type of variable which have to be interpolated 739 !--------------------------------------------------------------------- 740 CALL agrif_declare_var_top 741 742 ! 2. First interpolations of potentially non zero fields 743 !------------------------------------------------------- 744 Agrif_SpecialValue=0. 745 Agrif_UseSpecialValue = .TRUE. 746 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 747 Agrif_UseSpecialValue = .FALSE. 748 CALL Agrif_Sponge 749 tabspongedone_trn = .FALSE. 750 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 751 ! reset tsa to zero 752 tra(:,:,:,:) = 0. 753 754 ! 3. Some controls 755 !----------------- 756 check_namelist = .TRUE. 757 758 IF( check_namelist ) THEN 759 ! Check time steps 760 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 761 WRITE(cl_check1,*) Agrif_Parent(rdt) 762 WRITE(cl_check2,*) rdt 763 WRITE(cl_check3,*) rdt*Agrif_Rhot() 619 764 CALL ctl_stop( 'incompatible time step between grids', & 620 765 & 'parent grid value : '//cl_check1 , & … … 635 780 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 636 781 ENDIF 637 638 782 ENDIF 639 783 ! … … 655 799 !!---------------------------------------------------------------------- 656 800 801 802 803 !RB_CMEMS : declare here init for top 657 804 ! 1. Declaration of the type of variable which have to be interpolated 658 805 !--------------------------------------------------------------------- 659 806 ind1 = nbghostcells 660 ind2 = 1 + nbghostcells661 ind3 = 2 + nbghostcells 807 ind2 = 2 + nbghostcells_x 808 ind3 = 2 + nbghostcells_y_s 662 809 # if defined key_vertical 663 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)664 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)810 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 811 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 665 812 # else 666 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) 667 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) 813 ! LAURENT: STRANGE why (3,3) here ? 814 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) 815 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) 668 816 # endif 669 817 … … 705 853 !! *** ROUTINE agrif_init *** 706 854 !!---------------------------------------------------------------------- 707 USE agrif_oce 708 USE agrif_ice 709 USE in_out_manager 710 USE lib_mpp 855 USE agrif_oce 856 USE agrif_ice 857 USE dom_oce 858 USE in_out_manager 859 USE lib_mpp 711 860 !! 712 861 IMPLICIT NONE … … 714 863 INTEGER :: ios ! Local integer output status for namelist read 715 864 NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 716 & ln_spc_dyn, ln_chk_bathy 865 & ln_spc_dyn, ln_chk_bathy, ln_bry_south 717 866 !!-------------------------------------------------------------------------------------- 718 867 ! … … 735 884 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 736 885 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 737 ENDIF 738 ! 739 ! 740 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 886 WRITE(numout,*) ' south boundary ln_bry_south = ', ln_bry_south 887 ENDIF 888 ! 889 ! Set the number of ghost cells according to periodicity 890 nbghostcells_x = nbghostcells 891 nbghostcells_y_s = nbghostcells 892 nbghostcells_y_n = nbghostcells 893 ! 894 IF ( jperio == 1 ) nbghostcells_x = 0 895 IF ( .NOT. ln_bry_south ) nbghostcells_y_s = 0 896 897 ! Some checks 898 IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x ) & 899 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 900 IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) & 901 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 902 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 741 903 ! 742 904 END SUBROUTINE agrif_nemo_init 743 905 744 906 # if defined key_mpp_mpi 745 746 907 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 747 908 !!---------------------------------------------------------------------- … … 803 964 # endif 804 965 966 SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 967 !!---------------------------------------------------------------------- 968 !! *** ROUTINE Nemo_mapping *** 969 !!---------------------------------------------------------------------- 970 USE dom_oce 971 !! 972 IMPLICIT NONE 973 ! 974 INTEGER :: ndim 975 INTEGER :: ptx, pty 976 INTEGER, DIMENSION(ndim,2,2) :: bounds 977 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 978 LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 979 INTEGER :: nb_chunks 980 ! 981 INTEGER :: i 982 983 IF (agrif_debug_interp) THEN 984 DO i=1,ndim 985 WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 986 ENDDO 987 ENDIF 988 989 IF( bounds(2,2,2) > jpjglo) THEN 990 IF( bounds(2,1,2) <=jpjglo) THEN 991 nb_chunks = 2 992 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 993 ALLOCATE(correction_required(nb_chunks)) 994 DO i = 1,nb_chunks 995 bounds_chunks(i,:,:,:) = bounds 996 END DO 997 998 ! FIRST CHUNCK (for j<=jpjglo) 999 1000 ! Original indices 1001 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1002 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1003 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1004 bounds_chunks(1,2,2,1) = jpjglo 1005 1006 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1007 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1008 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1009 bounds_chunks(1,2,2,2) = jpjglo 1010 1011 ! Correction required or not 1012 correction_required(1)=.FALSE. 1013 1014 ! SECOND CHUNCK (for j>jpjglo) 1015 1016 ! Original indices 1017 bounds_chunks(2,1,1,1) = bounds(1,1,2) 1018 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1019 bounds_chunks(2,2,1,1) = jpjglo-2 1020 bounds_chunks(2,2,2,1) = bounds(2,2,2) 1021 1022 ! Where to find them 1023 ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 1024 1025 IF( ptx == 2) THEN ! T, V points 1026 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 1027 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 1028 ELSE ! U, F points 1029 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 1030 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1 1031 ENDIF 1032 1033 IF( pty == 2) THEN ! T, U points 1034 bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1035 bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo) 1036 ELSE ! V, F points 1037 bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1038 bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo) 1039 ENDIF 1040 ! Correction required or not 1041 correction_required(2)=.TRUE. 1042 1043 ELSE 1044 nb_chunks = 1 1045 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1046 ALLOCATE(correction_required(nb_chunks)) 1047 DO i=1,nb_chunks 1048 bounds_chunks(i,:,:,:) = bounds 1049 END DO 1050 1051 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1052 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1053 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1054 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1055 1056 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1057 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1058 1059 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 1060 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 1061 1062 IF( ptx == 2) THEN ! T, V points 1063 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1064 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1065 ELSE ! U, F points 1066 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 1067 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1 1068 ENDIF 1069 1070 IF (pty == 2) THEN ! T, U points 1071 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1072 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 1073 ELSE ! V, F points 1074 bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1075 bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 1076 ENDIF 1077 1078 correction_required(1)=.TRUE. 1079 ENDIF 1080 1081 ELSE IF (bounds(1,1,2) < 1) THEN 1082 IF (bounds(1,2,2) > 0) THEN 1083 nb_chunks = 2 1084 ALLOCATE(correction_required(nb_chunks)) 1085 correction_required=.FALSE. 1086 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1087 DO i=1,nb_chunks 1088 bounds_chunks(i,:,:,:) = bounds 1089 END DO 1090 1091 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1092 bounds_chunks(1,1,2,2) = 1+jpiglo-2 1093 1094 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1095 bounds_chunks(1,1,2,1) = 1 1096 1097 bounds_chunks(2,1,1,2) = 2 1098 bounds_chunks(2,1,2,2) = bounds(1,2,2) 1099 1100 bounds_chunks(2,1,1,1) = 2 1101 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1102 1103 ELSE 1104 nb_chunks = 1 1105 ALLOCATE(correction_required(nb_chunks)) 1106 correction_required=.FALSE. 1107 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1108 DO i=1,nb_chunks 1109 bounds_chunks(i,:,:,:) = bounds 1110 END DO 1111 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1112 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 1113 1114 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1115 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1116 ENDIF 1117 ELSE 1118 nb_chunks=1 1119 ALLOCATE(correction_required(nb_chunks)) 1120 correction_required=.FALSE. 1121 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1122 DO i=1,nb_chunks 1123 bounds_chunks(i,:,:,:) = bounds 1124 END DO 1125 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1126 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1127 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1128 bounds_chunks(1,2,2,2) = bounds(2,2,2) 1129 1130 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1131 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1132 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1133 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1134 ENDIF 1135 1136 END SUBROUTINE nemo_mapping 1137 1138 FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 1139 1140 USE dom_oce 1141 1142 INTEGER :: ptx, pty, i1, isens 1143 INTEGER :: agrif_external_switch_index 1144 1145 IF( isens == 1 ) THEN 1146 IF( ptx == 2 ) THEN ! T, V points 1147 agrif_external_switch_index = jpiglo-i1+2 1148 ELSE ! U, F points 1149 agrif_external_switch_index = jpiglo-i1+1 1150 ENDIF 1151 ELSE IF( isens ==2 ) THEN 1152 IF ( pty == 2 ) THEN ! T, U points 1153 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1154 ELSE ! V, F points 1155 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1156 ENDIF 1157 ENDIF 1158 1159 END function agrif_external_switch_index 1160 1161 SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 1162 !!---------------------------------------------------------------------- 1163 !! *** ROUTINE Correct_field *** 1164 !!---------------------------------------------------------------------- 1165 1166 USE dom_oce 1167 USE agrif_oce 1168 1169 INTEGER :: i1,i2,j1,j2 1170 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1171 1172 INTEGER :: i,j 1173 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1174 1175 tab2dtemp = tab2d 1176 1177 IF( .NOT. use_sign_north ) THEN 1178 DO j=j1,j2 1179 DO i=i1,i2 1180 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1181 END DO 1182 END DO 1183 ELSE 1184 DO j=j1,j2 1185 DO i=i1,i2 1186 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 1187 END DO 1188 END DO 1189 ENDIF 1190 1191 END SUBROUTINE Correct_field 1192 805 1193 #else 806 1194 SUBROUTINE Subcalledbyagrif
Note: See TracChangeset
for help on using the changeset viewer.