- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_user.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/NST/agrif_user.F90
r10425 r13463 1 1 #undef UPD_HIGH /* MIX HIGH UPDATE */ 2 2 #if defined key_agrif 3 !! * Substitutions 4 # include "do_loop_substitute.h90" 3 5 !!---------------------------------------------------------------------- 4 6 !! NEMO/NST 4.0 , NEMO Consortium (2018) … … 6 8 !! Software governed by the CeCILL license (see ./LICENSE) 7 9 !!---------------------------------------------------------------------- 8 SUBROUTINE agrif_user 9 END SUBROUTINE agrif_user 10 11 SUBROUTINE agrif_before_regridding 12 END SUBROUTINE agrif_before_regridding 13 14 SUBROUTINE Agrif_InitWorkspace 15 !!---------------------------------------------------------------------- 16 !! *** ROUTINE Agrif_InitWorkspace *** 17 !!---------------------------------------------------------------------- 18 USE par_oce 19 USE dom_oce 20 USE nemogcm 21 USE mppini 22 !! 23 IMPLICIT NONE 24 !!---------------------------------------------------------------------- 25 ! 26 IF( .NOT. Agrif_Root() ) THEN 27 ! no more static variables 28 !!$! JC: change to allow for different vertical levels 29 !!$! jpk is already set 30 !!$! keep it jpk possibly different from jpkglo which 31 !!$! hold parent grid vertical levels number (set earlier) 32 !!$! jpk = jpkglo 33 ENDIF 34 ! 35 END SUBROUTINE Agrif_InitWorkspace 36 37 38 SUBROUTINE Agrif_InitValues 10 SUBROUTINE agrif_user 11 END SUBROUTINE agrif_user 12 13 14 SUBROUTINE agrif_before_regridding 15 END SUBROUTINE agrif_before_regridding 16 17 18 SUBROUTINE Agrif_InitWorkspace 19 END SUBROUTINE Agrif_InitWorkspace 20 21 22 SUBROUTINE Agrif_InitValues 39 23 !!---------------------------------------------------------------------- 40 24 !! *** ROUTINE Agrif_InitValues *** 41 !! 42 !! ** Purpose :: Declaration of variables to be interpolated 43 !!---------------------------------------------------------------------- 44 USE Agrif_Util 45 USE oce 46 USE dom_oce 47 USE nemogcm 48 USE tradmp 49 USE bdy_oce , ONLY: ln_bdy 50 !! 51 IMPLICIT NONE 52 !!---------------------------------------------------------------------- 53 ! 54 CALL nemo_init !* Initializations of each fine grid 55 56 ! !* Agrif initialization 57 CALL agrif_nemo_init 58 CALL Agrif_InitValues_cont_dom 59 CALL Agrif_InitValues_cont 25 !!---------------------------------------------------------------------- 26 USE nemogcm 27 !!---------------------------------------------------------------------- 28 ! 29 CALL nemo_init !* Initializations of each fine grid 30 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 31 ! 32 ! !* Agrif initialization 33 CALL Agrif_InitValues_cont 60 34 # if defined key_top 61 CALL Agrif_InitValues_cont_top35 CALL Agrif_InitValues_cont_top 62 36 # endif 63 37 # if defined key_si3 64 CALL Agrif_InitValues_cont_ice38 CALL Agrif_InitValues_cont_ice 65 39 # endif 66 ! 67 END SUBROUTINE Agrif_initvalues 68 69 70 SUBROUTINE Agrif_InitValues_cont_dom 40 ! 41 END SUBROUTINE Agrif_initvalues 42 43 44 SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 45 !!---------------------------------------------------------------------- 46 !! *** ROUTINE agrif_istate *** 47 !!---------------------------------------------------------------------- 48 USE domvvl 49 USE domain 50 USE par_oce 51 USE agrif_oce 52 USE agrif_oce_interp 53 USE oce 54 USE lib_mpp 55 USE lbclnk 56 ! 57 IMPLICIT NONE 58 ! 59 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 60 INTEGER :: jn 61 !!---------------------------------------------------------------------- 62 IF(lwp) WRITE(numout,*) ' ' 63 IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 64 IF(lwp) WRITE(numout,*) ' ' 65 66 l_ini_child = .TRUE. 67 Agrif_SpecialValue = 0.0_wp 68 Agrif_UseSpecialValue = .TRUE. 69 uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp 70 71 Krhs_a = Kbb ; Kmm_a = Kbb 72 73 ! Brutal fix to pas 1x1 refinment. 74 ! IF(Agrif_Irhox() == 1) THEN 75 ! CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 76 ! ELSE 77 CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 78 79 ! ENDIF 80 ! just for VORTEX because Parent velocities can actually be exactly zero 81 ! Agrif_UseSpecialValue = .FALSE. 82 Agrif_UseSpecialValue = ln_spc_dyn 83 use_sign_north = .TRUE. 84 sign_north = -1. 85 CALL Agrif_Init_Variable(uini_id , procname=interpun ) 86 CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 87 use_sign_north = .FALSE. 88 89 Agrif_UseSpecialValue = .FALSE. 90 l_ini_child = .FALSE. 91 92 Krhs_a = Kaa ; Kmm_a = Kmm 93 94 DO jn = 1, jpts 95 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 96 END DO 97 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 98 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 99 100 101 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 102 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 103 104 END SUBROUTINE Agrif_Istate 105 106 107 SUBROUTINE agrif_declare_var_ini 108 !!---------------------------------------------------------------------- 109 !! *** ROUTINE agrif_declare_var_ini *** 110 !!---------------------------------------------------------------------- 111 USE agrif_util 112 USE agrif_oce 113 USE par_oce 114 USE zdf_oce 115 USE oce 116 USE dom_oce 117 ! 118 IMPLICIT NONE 119 ! 120 INTEGER :: ind1, ind2, ind3 121 INTEGER :: its 122 External :: nemo_mapping 123 !!---------------------------------------------------------------------- 124 125 ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 126 ! The procnames will not be called at these boundaries 127 IF (jperio == 1) THEN 128 CALL Agrif_Set_NearCommonBorderX(.TRUE.) 129 CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 130 ENDIF 131 132 IF ( .NOT. lk_south ) THEN 133 CALL Agrif_Set_NearCommonBorderY(.TRUE.) 134 ENDIF 135 136 ! 1. Declaration of the type of variable which have to be interpolated 137 !--------------------------------------------------------------------- 138 ind1 = nbghostcells 139 ind2 = nn_hls + 2 + nbghostcells_x 140 ind3 = nn_hls + 2 + nbghostcells_y_s 141 142 CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id) 143 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id) 144 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id) 145 146 CALL agrif_declare_variable((/1,2 /),(/ind2-1,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e1u_id) 147 CALL agrif_declare_variable((/2,1 /),(/ind2 ,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e2v_id) 148 149 ! Initial or restart velues 150 its = jpts+1 151 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 152 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), uini_id) 153 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id) 154 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id) 155 ! 156 157 ! 2. Type of interpolation 158 !------------------------- 159 CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant) 160 161 CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant) 162 CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant) 163 CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant) 164 CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant) 165 166 CALL Agrif_Set_bcinterp( e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm ) 167 CALL Agrif_Set_bcinterp( e2v_id,interp1=AGRIF_ppm , interp2=Agrif_linear ) 168 169 ! Initial fields 170 CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear ) 171 CALL Agrif_Set_interp ( tsini_id,interp =AGRIF_linear ) 172 CALL Agrif_Set_bcinterp( uini_id,interp =AGRIF_linear ) 173 CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear ) 174 CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear ) 175 CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear ) 176 CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear ) 177 CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear ) 178 179 ! 3. Location of interpolation 180 !----------------------------- 181 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 182 ! JC: check near the boundary only until matching in sponge has been sorted out: 183 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 184 185 ! extend the interpolation zone by 1 more point than necessary: 186 ! RB check here 187 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 188 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 189 190 CALL Agrif_Set_bc( e1u_id, (/0,ind1-1/) ) 191 CALL Agrif_Set_bc( e2v_id, (/0,ind1-1/) ) 192 193 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 194 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) ) 195 CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) ) 196 CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 197 198 ! 4. Update type 199 !--------------- 200 # if defined UPD_HIGH 201 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting) 202 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average ) 203 #else 204 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average ) 205 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy ) 206 #endif 207 208 ! CALL Agrif_Set_ExternalMapping(nemo_mapping) 209 ! 210 END SUBROUTINE agrif_declare_var_ini 211 212 213 SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 214 !!---------------------------------------------------------------------- 215 !! *** ROUTINE Agrif_Init_Domain *** 216 !!---------------------------------------------------------------------- 217 USE agrif_oce_update 218 USE agrif_oce_interp 219 USE agrif_oce_sponge 220 USE Agrif_Util 221 USE oce 222 USE dom_oce 223 USE zdf_oce 224 USE nemogcm 225 USE agrif_oce 226 ! 227 USE lbclnk 228 USE lib_mpp 229 USE in_out_manager 230 ! 231 IMPLICIT NONE 232 ! 233 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 234 ! 235 LOGICAL :: check_namelist 236 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 237 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 238 INTEGER :: ji, jj, jk 239 !!---------------------------------------------------------------------- 240 241 ! CALL Agrif_Declare_Var_ini 242 243 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 244 245 ! Build consistent parent bathymetry and number of levels 246 ! on the child grid 247 Agrif_UseSpecialValue = .FALSE. 248 ht0_parent( :,:) = 0._wp 249 mbkt_parent(:,:) = 0 250 ! 251 ! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 252 ! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 253 CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 254 CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 255 ! 256 ! Assume step wise change of bathymetry near interface 257 ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case 258 ! and no refinement 259 DO_2D( 1, 0, 1, 0 ) 260 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ), mbkt_parent(ji,jj) ) 261 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1), mbkt_parent(ji,jj) ) 262 END_2D 263 IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN 264 DO_2D( 1, 0, 1, 0 ) 265 hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) 266 hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) 267 END_2D 268 ELSE 269 DO_2D( 1, 0, 1, 0 ) 270 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 271 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 272 END_2D 273 ENDIF 274 ! 275 CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 276 DO_2D( 0, 0, 0, 0 ) 277 zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 278 END_2D 279 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 280 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 281 DO_2D( 0, 0, 0, 0 ) 282 zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 283 END_2D 284 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 285 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 286 287 IF ( ln_init_chfrpar ) THEN 288 CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 289 CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 290 DO jk = 1, jpk 291 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 292 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 293 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 294 END DO 295 ENDIF 296 297 ! check if masks and bathymetries match 298 IF(ln_chk_bathy) THEN 299 Agrif_UseSpecialValue = .FALSE. 300 ! 301 IF(lwp) WRITE(numout,*) ' ' 302 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 303 ! 304 kindic_agr = 0 305 IF( .NOT. l_vremap ) THEN 306 ! 307 ! check if tmask and vertical scale factors agree with parent in sponge area: 308 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 309 ! 310 ELSE 311 ! 312 ! In case of vertical interpolation, check only that total depths agree between child and parent: 313 DO ji = 1, jpi 314 DO jj = 1, jpj 315 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 316 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 317 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 318 END DO 319 END DO 320 321 CALL mpp_sum( 'agrif_user', kindic_agr ) 322 IF( kindic_agr /= 0 ) THEN 323 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 324 ELSE 325 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 326 IF(lwp) WRITE(numout,*) ' ' 327 ENDIF 328 ENDIF 329 ENDIF 330 331 IF( l_vremap ) THEN 332 ! Additional constrain that should be removed someday: 333 IF ( Agrif_Parent(jpk).GT.jpk ) THEN 334 CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 335 ENDIF 336 ENDIF 337 ! 338 END SUBROUTINE Agrif_Init_Domain 339 340 341 SUBROUTINE Agrif_InitValues_cont 71 342 !!---------------------------------------------------------------------- 72 343 !! *** ROUTINE Agrif_InitValues_cont *** … … 74 345 !! ** Purpose :: Declaration of variables to be interpolated 75 346 !!---------------------------------------------------------------------- 76 USE Agrif_Util 77 USE oce 78 USE dom_oce 79 USE nemogcm 80 USE in_out_manager 81 USE agrif_oce_update 82 USE agrif_oce_interp 83 USE agrif_oce_sponge 84 ! 85 IMPLICIT NONE 86 !!---------------------------------------------------------------------- 87 ! 88 ! Declaration of the type of variable which have to be interpolated 89 ! 90 CALL agrif_declare_var_dom 91 ! 92 END SUBROUTINE Agrif_InitValues_cont_dom 93 94 95 SUBROUTINE agrif_declare_var_dom 96 !!---------------------------------------------------------------------- 97 !! *** ROUTINE agrif_declare_var *** 98 !! 99 !! ** Purpose :: Declaration of variables to be interpolated 100 !!---------------------------------------------------------------------- 101 USE agrif_util 102 USE par_oce 103 USE oce 104 ! 105 IMPLICIT NONE 106 ! 107 INTEGER :: ind1, ind2, ind3 108 !!---------------------------------------------------------------------- 347 USE agrif_oce_update 348 USE agrif_oce_interp 349 USE agrif_oce_sponge 350 USE Agrif_Util 351 USE oce 352 USE dom_oce 353 USE zdf_oce 354 USE nemogcm 355 USE agrif_oce 356 ! 357 USE lbclnk 358 USE lib_mpp 359 USE in_out_manager 360 ! 361 IMPLICIT NONE 362 ! 363 LOGICAL :: check_namelist 364 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 365 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 366 INTEGER :: ji, jj 109 367 110 368 ! 1. Declaration of the type of variable which have to be interpolated 111 369 !--------------------------------------------------------------------- 112 ind1 = nbghostcells 113 ind2 = 1 + nbghostcells 114 ind3 = 2 + nbghostcells 115 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 116 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 117 370 CALL agrif_declare_var 371 372 ! 2. First interpolations of potentially non zero fields 373 !------------------------------------------------------- 374 Agrif_SpecialValue = 0._wp 375 Agrif_UseSpecialValue = .TRUE. 376 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn) 377 CALL Agrif_Sponge 378 tabspongedone_tsn = .FALSE. 379 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 380 ! reset tsa to zero 381 ts(:,:,:,:,Krhs_a) = 0._wp 382 383 Agrif_UseSpecialValue = ln_spc_dyn 384 use_sign_north = .TRUE. 385 sign_north = -1. 386 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 387 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 388 tabspongedone_u = .FALSE. 389 tabspongedone_v = .FALSE. 390 CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 391 tabspongedone_u = .FALSE. 392 tabspongedone_v = .FALSE. 393 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 394 use_sign_north = .FALSE. 395 uu(:,:,:,Krhs_a) = 0._wp 396 vv(:,:,:,Krhs_a) = 0._wp 397 398 Agrif_UseSpecialValue = .TRUE. 399 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 400 hbdy(:,:) = 0._wp 401 ssh(:,:,Krhs_a) = 0._wp 402 403 IF ( ln_dynspg_ts ) THEN 404 Agrif_UseSpecialValue = ln_spc_dyn 405 use_sign_north = .TRUE. 406 sign_north = -1. 407 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb ) 408 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb ) 409 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 410 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 411 use_sign_north = .FALSE. 412 ubdy(:,:) = 0._wp 413 vbdy(:,:) = 0._wp 414 ENDIF 415 Agrif_UseSpecialValue = .FALSE. 416 417 !----------------- 418 check_namelist = .TRUE. 419 420 IF( check_namelist ) THEN 421 ! Check free surface scheme 422 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 423 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 424 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 425 WRITE(cl_check2,*) ln_dynspg_ts 426 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 427 WRITE(cl_check4,*) ln_dynspg_exp 428 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 429 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 430 & 'child grid ln_dynspg_ts :'//cl_check2 , & 431 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 432 & 'child grid ln_dynspg_exp :'//cl_check4 , & 433 & 'those logicals should be identical' ) 434 STOP 435 ENDIF 436 437 ! Check if identical linear free surface option 438 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 439 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 440 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 441 WRITE(cl_check2,*) ln_linssh 442 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 443 & 'parent grid ln_linssh :'//cl_check1 , & 444 & 'child grid ln_linssh :'//cl_check2 , & 445 & 'those logicals should be identical' ) 446 STOP 447 ENDIF 448 ENDIF 449 450 END SUBROUTINE Agrif_InitValues_cont 451 452 SUBROUTINE agrif_declare_var 453 !!---------------------------------------------------------------------- 454 !! *** ROUTINE agrif_declare_var *** 455 !!---------------------------------------------------------------------- 456 USE agrif_util 457 USE agrif_oce 458 USE par_oce 459 USE zdf_oce 460 USE oce 461 ! 462 IMPLICIT NONE 463 ! 464 INTEGER :: ind1, ind2, ind3 465 !!---------------------------------------------------------------------- 466 467 ! 1. Declaration of the type of variable which have to be interpolated 468 !--------------------------------------------------------------------- 469 ind1 = nbghostcells 470 ind2 = nn_hls + 2 + nbghostcells_x 471 ind3 = nn_hls + 2 + nbghostcells_y_s 472 # if defined key_vertical 473 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 474 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 475 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 476 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 477 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 478 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 479 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 480 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 481 # else 482 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 483 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 484 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 485 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 486 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 487 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 488 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 489 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 490 # endif 491 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 492 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 493 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 494 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 495 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 496 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 497 498 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 499 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 500 CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 501 502 503 IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point 504 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 505 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 506 # if defined key_vertical 507 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 508 # else 509 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 510 # endif 511 ENDIF 512 118 513 ! 2. Type of interpolation 119 514 !------------------------- 120 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm ) 121 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear ) 515 CALL Agrif_Set_bcinterp( tsn_id,interp =AGRIF_linear) 516 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 517 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 518 519 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 520 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 521 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 522 523 CALL Agrif_Set_bcinterp( sshn_id,interp =AGRIF_linear) 524 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 525 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 526 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 527 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 528 ! 529 ! > Divergence conserving alternative: 530 ! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant) 531 ! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant) 532 ! CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear) 533 ! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant) 534 ! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear) 535 !< 536 537 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 538 539 540 ! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 541 ! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 122 542 123 543 ! 3. Location of interpolation 124 544 !----------------------------- 125 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 126 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 545 CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 546 CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 547 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) ) 548 549 CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west, rhox=3, nn_sponge_len=2 550 CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! and nbghost=3: 551 CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! columns 4 to 11 552 553 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) ) 554 CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) ) 555 CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) ) 556 CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 557 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 558 559 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 560 !!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 561 !!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 127 562 128 563 ! 4. Update type 129 564 !--------------- 565 130 566 # if defined UPD_HIGH 131 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 132 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 567 CALL Agrif_Set_Updatetype( tsn_id,update = Agrif_Update_Full_Weighting) 568 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 569 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 570 571 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 572 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 573 CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting) 574 CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting) 575 576 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 577 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 578 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 579 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 580 ! ENDIF 581 133 582 #else 134 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 135 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 583 CALL Agrif_Set_Updatetype( tsn_id, update = AGRIF_Update_Average) 584 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 585 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 586 587 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 588 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 589 CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average) 590 CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average) 591 592 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 593 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 594 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 595 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 596 ! ENDIF 597 136 598 #endif 137 138 END SUBROUTINE agrif_declare_var_dom 139 140 141 SUBROUTINE Agrif_InitValues_cont 142 !!---------------------------------------------------------------------- 143 !! *** ROUTINE Agrif_InitValues_cont *** 144 !! 145 !! ** Purpose :: Declaration of variables to be interpolated 146 !!---------------------------------------------------------------------- 147 USE agrif_oce_update 148 USE agrif_oce_interp 149 USE agrif_oce_sponge 150 USE Agrif_Util 151 USE oce 152 USE dom_oce 153 USE zdf_oce 154 USE nemogcm 155 ! 156 USE lib_mpp 157 USE in_out_manager 158 ! 159 IMPLICIT NONE 160 ! 161 LOGICAL :: check_namelist 162 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 163 !!---------------------------------------------------------------------- 164 165 ! 1. Declaration of the type of variable which have to be interpolated 166 !--------------------------------------------------------------------- 167 CALL agrif_declare_var 168 169 ! 2. First interpolations of potentially non zero fields 170 !------------------------------------------------------- 171 Agrif_SpecialValue = 0._wp 172 Agrif_UseSpecialValue = .TRUE. 173 CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 174 CALL Agrif_Sponge 175 tabspongedone_tsn = .FALSE. 176 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 177 ! reset tsa to zero 178 tsa(:,:,:,:) = 0. 179 180 Agrif_UseSpecialValue = ln_spc_dyn 181 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 182 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 183 tabspongedone_u = .FALSE. 184 tabspongedone_v = .FALSE. 185 CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 186 tabspongedone_u = .FALSE. 187 tabspongedone_v = .FALSE. 188 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 189 190 Agrif_UseSpecialValue = .TRUE. 191 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 192 hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 193 ssha(:,:) = 0.e0 194 195 IF ( ln_dynspg_ts ) THEN 196 Agrif_UseSpecialValue = ln_spc_dyn 197 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 198 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 199 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 200 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 201 ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0 202 ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0 203 ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0 204 ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0 205 ENDIF 206 207 Agrif_UseSpecialValue = .FALSE. 208 ! reset velocities to zero 209 ua(:,:,:) = 0. 210 va(:,:,:) = 0. 211 212 ! 3. Some controls 213 !----------------- 214 check_namelist = .TRUE. 215 216 IF( check_namelist ) THEN 217 218 ! Check time steps 219 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 220 WRITE(cl_check1,*) NINT(Agrif_Parent(rdt)) 221 WRITE(cl_check2,*) NINT(rdt) 222 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 223 CALL ctl_stop( 'Incompatible time step between ocean grids', & 224 & 'parent grid value : '//cl_check1 , & 225 & 'child grid value : '//cl_check2 , & 226 & 'value on child grid should be changed to : '//cl_check3 ) 227 ENDIF 228 229 ! Check run length 230 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 231 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 232 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 233 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 234 CALL ctl_warn( 'Incompatible run length between grids' , & 235 & 'nit000 on fine grid will be changed to : '//cl_check1, & 236 & 'nitend on fine grid will be changed to : '//cl_check2 ) 237 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 238 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 239 ENDIF 240 241 ! Check free surface scheme 242 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 243 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 244 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 245 WRITE(cl_check2,*) ln_dynspg_ts 246 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 247 WRITE(cl_check4,*) ln_dynspg_exp 248 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 249 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 250 & 'child grid ln_dynspg_ts :'//cl_check2 , & 251 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 252 & 'child grid ln_dynspg_exp :'//cl_check4 , & 253 & 'those logicals should be identical' ) 254 STOP 255 ENDIF 256 257 ! Check if identical linear free surface option 258 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 259 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 260 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 261 WRITE(cl_check2,*) ln_linssh 262 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 263 & 'parent grid ln_linssh :'//cl_check1 , & 264 & 'child grid ln_linssh :'//cl_check2 , & 265 & 'those logicals should be identical' ) 266 STOP 267 ENDIF 268 269 ! check if masks and bathymetries match 270 IF(ln_chk_bathy) THEN 271 ! 272 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 273 ! 274 kindic_agr = 0 275 ! check if umask agree with parent along western and eastern boundaries: 276 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 277 ! check if vmask agree with parent along northern and southern boundaries: 278 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 279 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 280 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 281 ! 282 CALL mpp_sum( 'agrif_user', kindic_agr ) 283 IF( kindic_agr /= 0 ) THEN 284 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 285 ELSE 286 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 287 END IF 288 ENDIF 289 ! 290 ENDIF 291 ! 292 END SUBROUTINE Agrif_InitValues_cont 293 294 SUBROUTINE agrif_declare_var 295 !!---------------------------------------------------------------------- 296 !! *** ROUTINE agrif_declarE_var *** 297 !! 298 !! ** Purpose :: Declaration of variables to be interpolated 299 !!---------------------------------------------------------------------- 300 USE agrif_util 301 USE agrif_oce 302 USE par_oce ! ocean parameters 303 USE zdf_oce ! vertical physics 304 USE oce 305 ! 306 IMPLICIT NONE 307 ! 308 INTEGER :: ind1, ind2, ind3 309 !!---------------------------------------------------------------------- 310 311 ! 1. Declaration of the type of variable which have to be interpolated 312 !--------------------------------------------------------------------- 313 ind1 = nbghostcells 314 ind2 = 1 + nbghostcells 315 ind3 = 2 + nbghostcells 316 # if defined key_vertical 317 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) 318 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) 319 320 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) 321 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 322 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) 323 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 324 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) 325 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 599 ! 600 END SUBROUTINE agrif_declare_var 601 602 #if defined key_si3 603 SUBROUTINE Agrif_InitValues_cont_ice 604 !!---------------------------------------------------------------------- 605 !! *** ROUTINE Agrif_InitValues_cont_ice *** 606 !!---------------------------------------------------------------------- 607 USE Agrif_Util 608 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 609 USE ice 610 USE agrif_ice 611 USE in_out_manager 612 USE agrif_ice_interp 613 USE lib_mpp 614 ! 615 IMPLICIT NONE 616 ! 617 !!---------------------------------------------------------------------- 618 ! Controls 619 620 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 621 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 622 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 623 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 624 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 625 626 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 627 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN 628 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 629 ENDIF 630 ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 631 !---------------------------------------------------------------------- 632 nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 633 CALL agrif_interp_ice('U') ! interpolation of ice velocities 634 CALL agrif_interp_ice('V') ! interpolation of ice velocities 635 CALL agrif_interp_ice('T') ! interpolation of ice tracers 636 nbstep_ice = 0 637 ! 638 END SUBROUTINE Agrif_InitValues_cont_ice 639 640 641 SUBROUTINE agrif_declare_var_ice 642 !!---------------------------------------------------------------------- 643 !! *** ROUTINE agrif_declare_var_ice *** 644 !!---------------------------------------------------------------------- 645 USE Agrif_Util 646 USE ice 647 USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 648 ! 649 IMPLICIT NONE 650 ! 651 INTEGER :: ind1, ind2, ind3 652 INTEGER :: ipl 653 !!---------------------------------------------------------------------- 654 ! 655 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 656 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name) 657 ! ex.: position=> 1,1 = not-centered (in i and j) 658 ! 2,2 = centered ( - ) 659 ! index => 1,1 = one ghost line 660 ! 2,2 = two ghost lines 661 !------------------------------------------------------------------------------------- 662 ind1 = nbghostcells 663 ind2 = nn_hls + 2 + nbghostcells_x 664 ind3 = nn_hls + 2 + nbghostcells_y_s 665 ipl = jpl*(8+nlay_s+nlay_i) 666 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 667 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id) 668 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id) 669 670 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 671 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id) 672 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id) 673 674 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 675 !----------------------------------- 676 CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear) 677 CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm ) 678 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 679 680 CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear) 681 CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear) 682 CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear ) 683 CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear ) 684 CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear) 685 CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear) 686 687 ! 3. Set location of interpolations 688 !---------------------------------- 689 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 690 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 691 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 692 693 CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 694 CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/)) 695 CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/)) 696 697 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 698 !-------------------------------------------------- 699 # if defined UPD_HIGH 700 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 701 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 702 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 326 703 # else 327 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) 328 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) 329 330 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) 331 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 332 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) 333 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 334 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) 335 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 704 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 705 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 706 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 336 707 # endif 337 708 338 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 339 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 340 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 341 342 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) 343 344 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 345 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 346 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 347 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 348 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 349 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 350 351 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 352 353 IF( ln_zdftke.OR.ln_zdfgls ) THEN 354 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 355 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 356 # if defined key_vertical 357 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 358 # else 359 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 360 # endif 361 ENDIF 362 363 ! 2. Type of interpolation 364 !------------------------- 365 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 366 367 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 368 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 369 370 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 371 372 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 373 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 374 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 375 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 376 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 377 378 379 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 380 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 381 382 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 383 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 384 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 385 386 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 387 388 ! 3. Location of interpolation 389 !----------------------------- 390 CALL Agrif_Set_bc( tsn_id, (/0,ind1/) ) 391 CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) ) 392 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) ) 393 394 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 395 CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 396 CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 397 398 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) ) 399 CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) ) 400 CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) ) 401 CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 402 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 403 404 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west and rhox=3 and ghost=1: column 2 to 6 405 CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 406 CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 407 408 409 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 410 411 ! 4. Update type 412 !--------------- 413 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 414 415 # if defined UPD_HIGH 416 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 417 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 418 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 419 420 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 421 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 422 CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 423 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 424 425 IF( ln_zdftke.OR.ln_zdfgls ) THEN 426 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 427 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 428 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 429 ENDIF 430 431 #else 432 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 433 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 434 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 435 436 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 437 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 438 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 439 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 440 441 IF( ln_zdftke.OR.ln_zdfgls ) THEN 442 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 443 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 444 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 445 ENDIF 446 709 END SUBROUTINE agrif_declare_var_ice 447 710 #endif 448 !449 END SUBROUTINE agrif_declare_var450 451 #if defined key_si3452 SUBROUTINE Agrif_InitValues_cont_ice453 !!----------------------------------------------------------------------454 !! *** ROUTINE Agrif_InitValues_cont_ice ***455 !!456 !! ** Purpose :: Initialisation of variables to be interpolated for ice457 !!----------------------------------------------------------------------458 USE Agrif_Util459 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc460 USE ice461 USE agrif_ice462 USE in_out_manager463 USE agrif_ice_interp464 USE lib_mpp465 !466 IMPLICIT NONE467 !!----------------------------------------------------------------------468 !469 ! Declaration of the type of variable which have to be interpolated (parent=>child)470 !----------------------------------------------------------------------------------471 CALL agrif_declare_var_ice472 473 ! Controls474 475 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)476 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)477 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable478 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account479 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')480 481 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer482 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN483 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')484 ENDIF485 ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)486 !----------------------------------------------------------------------487 nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)488 CALL agrif_interp_ice('U') ! interpolation of ice velocities489 CALL agrif_interp_ice('V') ! interpolation of ice velocities490 CALL agrif_interp_ice('T') ! interpolation of ice tracers491 nbstep_ice = 0492 493 !494 END SUBROUTINE Agrif_InitValues_cont_ice495 496 SUBROUTINE agrif_declare_var_ice497 !!----------------------------------------------------------------------498 !! *** ROUTINE agrif_declare_var_ice ***499 !!500 !! ** Purpose :: Declaration of variables to be interpolated for ice501 !!----------------------------------------------------------------------502 USE Agrif_Util503 USE ice504 USE par_oce, ONLY : nbghostcells505 !506 IMPLICIT NONE507 !508 INTEGER :: ind1, ind2, ind3509 !!----------------------------------------------------------------------510 !511 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)512 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name)513 ! ex.: position=> 1,1 = not-centered (in i and j)514 ! 2,2 = centered ( - )515 ! index => 1,1 = one ghost line516 ! 2,2 = two ghost lines517 !-------------------------------------------------------------------------------------518 ind1 = nbghostcells519 ind2 = 1 + nbghostcells520 ind3 = 2 + nbghostcells521 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)522 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id )523 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id )524 525 ! 2. Set interpolations (normal & tangent to the grid cell for velocities)526 !-----------------------------------527 CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)528 CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )529 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)530 531 ! 3. Set location of interpolations532 !----------------------------------533 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))534 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))535 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))536 537 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)538 !--------------------------------------------------539 # if defined UPD_HIGH540 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)541 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)542 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )543 #else544 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)545 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)546 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )547 #endif548 549 END SUBROUTINE agrif_declare_var_ice550 #endif551 711 552 712 553 713 # if defined key_top 554 SUBROUTINE Agrif_InitValues_cont_top714 SUBROUTINE Agrif_InitValues_cont_top 555 715 !!---------------------------------------------------------------------- 556 716 !! *** ROUTINE Agrif_InitValues_cont_top *** 557 !! 558 !! ** Purpose :: Declaration of variables to be interpolated 559 !!---------------------------------------------------------------------- 560 USE Agrif_Util 561 USE oce 562 USE dom_oce 563 USE nemogcm 564 USE par_trc 565 USE lib_mpp 566 USE trc 567 USE in_out_manager 568 USE agrif_oce_sponge 569 USE agrif_top_update 570 USE agrif_top_interp 571 USE agrif_top_sponge 572 !! 573 IMPLICIT NONE 574 ! 575 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 576 LOGICAL :: check_namelist 577 !!---------------------------------------------------------------------- 578 579 580 ! 1. Declaration of the type of variable which have to be interpolated 581 !--------------------------------------------------------------------- 582 CALL agrif_declare_var_top 583 584 ! 2. First interpolations of potentially non zero fields 585 !------------------------------------------------------- 586 Agrif_SpecialValue=0. 587 Agrif_UseSpecialValue = .TRUE. 588 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 589 Agrif_UseSpecialValue = .FALSE. 590 CALL Agrif_Sponge 591 tabspongedone_trn = .FALSE. 592 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 593 ! reset tsa to zero 594 tra(:,:,:,:) = 0. 595 596 597 ! 3. Some controls 598 !----------------- 599 check_namelist = .TRUE. 600 601 IF( check_namelist ) THEN 602 ! Check time steps 603 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 604 WRITE(cl_check1,*) Agrif_Parent(rdt) 605 WRITE(cl_check2,*) rdt 606 WRITE(cl_check3,*) rdt*Agrif_Rhot() 607 CALL ctl_stop( 'incompatible time step between grids', & 717 !!---------------------------------------------------------------------- 718 USE Agrif_Util 719 USE oce 720 USE dom_oce 721 USE nemogcm 722 USE par_trc 723 USE lib_mpp 724 USE trc 725 USE in_out_manager 726 USE agrif_oce_sponge 727 USE agrif_top_update 728 USE agrif_top_interp 729 USE agrif_top_sponge 730 ! 731 IMPLICIT NONE 732 ! 733 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 734 LOGICAL :: check_namelist 735 !!---------------------------------------------------------------------- 736 737 ! 1. Declaration of the type of variable which have to be interpolated 738 !--------------------------------------------------------------------- 739 CALL agrif_declare_var_top 740 741 ! 2. First interpolations of potentially non zero fields 742 !------------------------------------------------------- 743 Agrif_SpecialValue=0._wp 744 Agrif_UseSpecialValue = .TRUE. 745 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 746 Agrif_UseSpecialValue = .FALSE. 747 CALL Agrif_Sponge 748 tabspongedone_trn = .FALSE. 749 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 750 ! reset tsa to zero 751 tra(:,:,:,:) = 0._wp 752 753 ! 3. Some controls 754 !----------------- 755 check_namelist = .TRUE. 756 757 IF( check_namelist ) THEN 758 ! Check time steps 759 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 760 WRITE(cl_check1,*) Agrif_Parent(rdt) 761 WRITE(cl_check2,*) rdt 762 WRITE(cl_check3,*) rdt*Agrif_Rhot() 763 CALL ctl_stop( 'incompatible time step between grids', & 608 764 & 'parent grid value : '//cl_check1 , & 609 765 & 'child grid value : '//cl_check2 , & 610 766 & 'value on child grid should be changed to & 611 767 & :'//cl_check3 ) 612 ENDIF613 614 ! Check run length615 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &768 ENDIF 769 770 ! Check run length 771 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 616 772 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 617 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1618 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()619 CALL ctl_warn( 'incompatible run length between grids' , &773 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 774 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 775 CALL ctl_warn( 'incompatible run length between grids' , & 620 776 & ' nit000 on fine grid will be change to : '//cl_check1, & 621 777 & ' nitend on fine grid will be change to : '//cl_check2 ) 622 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 623 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 624 ENDIF 625 626 ! Check passive tracer cell 627 IF( nn_dttrc .NE. 1 ) THEN 628 WRITE(*,*) 'nn_dttrc should be equal to 1' 629 ENDIF 630 ENDIF 631 ! 632 END SUBROUTINE Agrif_InitValues_cont_top 633 634 635 SUBROUTINE agrif_declare_var_top 778 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 779 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 780 ENDIF 781 ENDIF 782 ! 783 END SUBROUTINE Agrif_InitValues_cont_top 784 785 786 SUBROUTINE agrif_declare_var_top 636 787 !!---------------------------------------------------------------------- 637 788 !! *** ROUTINE agrif_declare_var_top *** 789 !!---------------------------------------------------------------------- 790 USE agrif_util 791 USE agrif_oce 792 USE dom_oce 793 USE trc 638 794 !! 639 !! ** Purpose :: Declaration of TOP variables to be interpolated 640 !!---------------------------------------------------------------------- 641 USE agrif_util 642 USE agrif_oce 643 USE dom_oce 644 USE trc 645 !! 646 IMPLICIT NONE 647 ! 648 INTEGER :: ind1, ind2, ind3 649 !!---------------------------------------------------------------------- 650 651 ! 1. Declaration of the type of variable which have to be interpolated 652 !--------------------------------------------------------------------- 653 ind1 = nbghostcells 654 ind2 = 1 + nbghostcells 655 ind3 = 2 + nbghostcells 795 IMPLICIT NONE 796 ! 797 INTEGER :: ind1, ind2, ind3 798 !!---------------------------------------------------------------------- 799 !RB_CMEMS : declare here init for top 800 ! 1. Declaration of the type of variable which have to be interpolated 801 !--------------------------------------------------------------------- 802 ind1 = nbghostcells 803 ind2 = nn_hls + 2 + nbghostcells_x 804 ind3 = nn_hls + 2 + nbghostcells_y_s 656 805 # if defined key_vertical 657 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)658 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)806 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 807 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 659 808 # else 660 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) 661 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) 809 ! LAURENT: STRANGE why (3,3) here ? 810 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 811 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 662 812 # endif 663 813 664 ! 2. Type of interpolation665 !-------------------------666 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)667 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)668 669 ! 3. Location of interpolation670 !-----------------------------671 CALL Agrif_Set_bc(trn_id,(/0,ind1/))672 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))673 674 ! 4. Update type675 !---------------814 ! 2. Type of interpolation 815 !------------------------- 816 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 817 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 818 819 ! 3. Location of interpolation 820 !----------------------------- 821 CALL Agrif_Set_bc(trn_id,(/0,ind1-1/)) 822 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 823 824 ! 4. Update type 825 !--------------- 676 826 # if defined UPD_HIGH 677 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)827 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 678 828 #else 679 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)829 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 680 830 #endif 681 831 ! 682 END SUBROUTINE agrif_declare_var_top832 END SUBROUTINE agrif_declare_var_top 683 833 # endif 684 685 SUBROUTINE Agrif_detect( kg, ksizex ) 834 835 836 SUBROUTINE Agrif_detect( kg, ksizex ) 686 837 !!---------------------------------------------------------------------- 687 838 !! *** ROUTINE Agrif_detect *** 688 839 !!---------------------------------------------------------------------- 689 INTEGER, DIMENSION(2) :: ksizex690 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg691 !!---------------------------------------------------------------------- 692 !693 RETURN694 !695 END SUBROUTINE Agrif_detect696 697 698 SUBROUTINE agrif_nemo_init840 INTEGER, DIMENSION(2) :: ksizex 841 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 842 !!---------------------------------------------------------------------- 843 ! 844 RETURN 845 ! 846 END SUBROUTINE Agrif_detect 847 848 849 SUBROUTINE agrif_nemo_init 699 850 !!---------------------------------------------------------------------- 700 851 !! *** ROUTINE agrif_init *** 701 852 !!---------------------------------------------------------------------- 702 USE agrif_oce 703 USE agrif_ice 704 USE in_out_manager 705 USE lib_mpp 706 !! 707 IMPLICIT NONE 708 ! 709 INTEGER :: ios ! Local integer output status for namelist read 710 INTEGER :: iminspon 711 NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 853 USE agrif_oce 854 USE agrif_ice 855 USE dom_oce 856 USE in_out_manager 857 USE lib_mpp 858 ! 859 IMPLICIT NONE 860 ! 861 INTEGER :: ios ! Local integer output status for namelist read 862 NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 863 & ln_spc_dyn, ln_chk_bathy 712 864 !!-------------------------------------------------------------------------------------- 713 ! 714 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom 715 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 716 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 717 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom 718 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 719 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 720 IF(lwm) WRITE ( numond, namagrif ) 721 ! 722 IF(lwp) THEN ! control print 723 WRITE(numout,*) 724 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 725 WRITE(numout,*) '~~~~~~~~~~~~~~~' 726 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 727 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s' 728 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' 729 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 730 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 731 ENDIF 732 ! 733 ! convert DOCTOR namelist name into OLD names 734 visc_tra = rn_sponge_tra 735 visc_dyn = rn_sponge_dyn 736 ! 737 ! Check sponge length: 738 iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 739 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 740 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 741 ! 742 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 743 ! 744 END SUBROUTINE agrif_nemo_init 745 865 ! 866 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 867 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 868 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 869 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 870 IF(lwm) WRITE ( numond, namagrif ) 871 ! 872 IF(lwp) THEN ! control print 873 WRITE(numout,*) 874 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 875 WRITE(numout,*) '~~~~~~~~~~~~~~~' 876 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 877 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 878 WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 879 WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra 880 WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn 881 WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra 882 WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn 883 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 884 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 885 ENDIF 886 887 lk_west = .NOT. ( Agrif_Ix() == 1 ) 888 lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 889 lk_south = .NOT. ( Agrif_Iy() == 1 ) 890 lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 891 892 ! 893 ! Set the number of ghost cells according to periodicity 894 nbghostcells_x = nbghostcells 895 nbghostcells_y_s = nbghostcells 896 nbghostcells_y_n = nbghostcells 897 ! 898 IF( jperio == 1 ) nbghostcells_x = 0 899 IF( .NOT. lk_south ) nbghostcells_y_s = 0 900 ! Some checks 901 IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', & 902 & 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 903 IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', & 904 & 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 905 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 906 ! 907 END SUBROUTINE agrif_nemo_init 908 909 746 910 # if defined key_mpp_mpi 747 748 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 911 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 749 912 !!---------------------------------------------------------------------- 750 913 !! *** ROUTINE Agrif_InvLoc *** 751 914 !!---------------------------------------------------------------------- 752 USE dom_oce 753 !! 754 IMPLICIT NONE 755 ! 756 INTEGER :: indglob, indloc, nprocloc, i 757 !!---------------------------------------------------------------------- 758 ! 759 SELECT CASE( i ) 760 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 761 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 762 CASE DEFAULT 763 indglob = indloc 764 END SELECT 765 ! 766 END SUBROUTINE Agrif_InvLoc 767 768 769 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 915 USE dom_oce 916 !! 917 IMPLICIT NONE 918 ! 919 INTEGER :: indglob, indloc, nprocloc, i 920 !!---------------------------------------------------------------------- 921 ! 922 SELECT CASE( i ) 923 CASE(1) ; indglob = mig(indloc) 924 CASE(2) ; indglob = mjg(indloc) 925 CASE DEFAULT ; indglob = indloc 926 END SELECT 927 ! 928 END SUBROUTINE Agrif_InvLoc 929 930 931 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 770 932 !!---------------------------------------------------------------------- 771 933 !! *** ROUTINE Agrif_get_proc_info *** 772 934 !!---------------------------------------------------------------------- 773 USE par_oce774 !!775 IMPLICIT NONE776 !777 INTEGER, INTENT(out) :: imin, imax778 INTEGER, INTENT(out) :: jmin, jmax779 !!---------------------------------------------------------------------- 780 !781 imin = nimppt(Agrif_Procrank+1) ! ?????782 jmin = njmppt(Agrif_Procrank+1) ! ?????783 imax = imin + jpi - 1784 jmax = jmin + jpj - 1785 !786 END SUBROUTINE Agrif_get_proc_info787 788 789 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)935 USE par_oce 936 !! 937 IMPLICIT NONE 938 ! 939 INTEGER, INTENT(out) :: imin, imax 940 INTEGER, INTENT(out) :: jmin, jmax 941 !!---------------------------------------------------------------------- 942 ! 943 imin = mig( 1 ) 944 jmin = mjg( 1 ) 945 imax = mig(jpi) 946 jmax = mjg(jpj) 947 ! 948 END SUBROUTINE Agrif_get_proc_info 949 950 951 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 790 952 !!---------------------------------------------------------------------- 791 953 !! *** ROUTINE Agrif_estimate_parallel_cost *** 792 954 !!---------------------------------------------------------------------- 793 USE par_oce794 !!795 IMPLICIT NONE796 !797 INTEGER, INTENT(in) :: imin, imax798 INTEGER, INTENT(in) :: jmin, jmax799 INTEGER, INTENT(in) :: nbprocs800 REAL(wp), INTENT(out) :: grid_cost801 !!---------------------------------------------------------------------- 802 !803 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)804 !805 END SUBROUTINE Agrif_estimate_parallel_cost955 USE par_oce 956 !! 957 IMPLICIT NONE 958 ! 959 INTEGER, INTENT(in) :: imin, imax 960 INTEGER, INTENT(in) :: jmin, jmax 961 INTEGER, INTENT(in) :: nbprocs 962 REAL(wp), INTENT(out) :: grid_cost 963 !!---------------------------------------------------------------------- 964 ! 965 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 966 ! 967 END SUBROUTINE Agrif_estimate_parallel_cost 806 968 807 969 # endif 808 970 971 SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 972 !!---------------------------------------------------------------------- 973 !! *** ROUTINE Nemo_mapping *** 974 !!---------------------------------------------------------------------- 975 USE dom_oce 976 !! 977 IMPLICIT NONE 978 ! 979 INTEGER :: ndim 980 INTEGER :: ptx, pty 981 INTEGER, DIMENSION(ndim,2,2) :: bounds 982 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 983 LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 984 INTEGER :: nb_chunks 985 ! 986 INTEGER :: i 987 988 IF (agrif_debug_interp) THEN 989 DO i=1,ndim 990 WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 991 ENDDO 992 ENDIF 993 994 IF( bounds(2,2,2) > jpjglo) THEN 995 IF( bounds(2,1,2) <=jpjglo) THEN 996 nb_chunks = 2 997 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 998 ALLOCATE(correction_required(nb_chunks)) 999 DO i = 1,nb_chunks 1000 bounds_chunks(i,:,:,:) = bounds 1001 END DO 1002 1003 ! FIRST CHUNCK (for j<=jpjglo) 1004 1005 ! Original indices 1006 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1007 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1008 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1009 bounds_chunks(1,2,2,1) = jpjglo 1010 1011 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1012 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1013 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1014 bounds_chunks(1,2,2,2) = jpjglo 1015 1016 ! Correction required or not 1017 correction_required(1)=.FALSE. 1018 1019 ! SECOND CHUNCK (for j>jpjglo) 1020 1021 ! Original indices 1022 bounds_chunks(2,1,1,1) = bounds(1,1,2) 1023 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1024 bounds_chunks(2,2,1,1) = jpjglo-2 1025 bounds_chunks(2,2,2,1) = bounds(2,2,2) 1026 1027 ! Where to find them 1028 ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 1029 1030 IF( ptx == 2) THEN ! T, V points 1031 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 1032 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 1033 ELSE ! U, F points 1034 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 1035 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1 1036 ENDIF 1037 1038 IF( pty == 2) THEN ! T, U points 1039 bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1040 bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo) 1041 ELSE ! V, F points 1042 bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1043 bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo) 1044 ENDIF 1045 ! Correction required or not 1046 correction_required(2)=.TRUE. 1047 1048 ELSE 1049 nb_chunks = 1 1050 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1051 ALLOCATE(correction_required(nb_chunks)) 1052 DO i=1,nb_chunks 1053 bounds_chunks(i,:,:,:) = bounds 1054 END DO 1055 1056 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1057 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1058 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1059 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1060 1061 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1062 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1063 1064 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 1065 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 1066 1067 IF( ptx == 2) THEN ! T, V points 1068 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1069 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1070 ELSE ! U, F points 1071 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 1072 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1 1073 ENDIF 1074 1075 IF (pty == 2) THEN ! T, U points 1076 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1077 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 1078 ELSE ! V, F points 1079 bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1080 bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 1081 ENDIF 1082 1083 correction_required(1)=.TRUE. 1084 ENDIF 1085 1086 ELSE IF (bounds(1,1,2) < 1) THEN 1087 IF (bounds(1,2,2) > 0) THEN 1088 nb_chunks = 2 1089 ALLOCATE(correction_required(nb_chunks)) 1090 correction_required=.FALSE. 1091 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1092 DO i=1,nb_chunks 1093 bounds_chunks(i,:,:,:) = bounds 1094 END DO 1095 1096 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1097 bounds_chunks(1,1,2,2) = 1+jpiglo-2 1098 1099 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1100 bounds_chunks(1,1,2,1) = 1 1101 1102 bounds_chunks(2,1,1,2) = 2 1103 bounds_chunks(2,1,2,2) = bounds(1,2,2) 1104 1105 bounds_chunks(2,1,1,1) = 2 1106 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1107 1108 ELSE 1109 nb_chunks = 1 1110 ALLOCATE(correction_required(nb_chunks)) 1111 correction_required=.FALSE. 1112 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1113 DO i=1,nb_chunks 1114 bounds_chunks(i,:,:,:) = bounds 1115 END DO 1116 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1117 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 1118 1119 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1120 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1121 ENDIF 1122 ELSE 1123 nb_chunks=1 1124 ALLOCATE(correction_required(nb_chunks)) 1125 correction_required=.FALSE. 1126 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1127 DO i=1,nb_chunks 1128 bounds_chunks(i,:,:,:) = bounds 1129 END DO 1130 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1131 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1132 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1133 bounds_chunks(1,2,2,2) = bounds(2,2,2) 1134 1135 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1136 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1137 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1138 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1139 ENDIF 1140 1141 END SUBROUTINE nemo_mapping 1142 1143 FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 1144 1145 USE dom_oce 1146 ! 1147 IMPLICIT NONE 1148 1149 INTEGER :: ptx, pty, i1, isens 1150 INTEGER :: agrif_external_switch_index 1151 !!---------------------------------------------------------------------- 1152 1153 IF( isens == 1 ) THEN 1154 IF( ptx == 2 ) THEN ! T, V points 1155 agrif_external_switch_index = jpiglo-i1+2 1156 ELSE ! U, F points 1157 agrif_external_switch_index = jpiglo-i1+1 1158 ENDIF 1159 ELSE IF( isens ==2 ) THEN 1160 IF ( pty == 2 ) THEN ! T, U points 1161 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1162 ELSE ! V, F points 1163 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1164 ENDIF 1165 ENDIF 1166 1167 END FUNCTION agrif_external_switch_index 1168 1169 SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 1170 !!---------------------------------------------------------------------- 1171 !! *** ROUTINE Correct_field *** 1172 !!---------------------------------------------------------------------- 1173 USE dom_oce 1174 USE agrif_oce 1175 ! 1176 IMPLICIT NONE 1177 ! 1178 INTEGER :: i1,i2,j1,j2 1179 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1180 ! 1181 INTEGER :: i,j 1182 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1183 !!---------------------------------------------------------------------- 1184 1185 tab2dtemp = tab2d 1186 1187 IF( .NOT. use_sign_north ) THEN 1188 DO j=j1,j2 1189 DO i=i1,i2 1190 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1191 END DO 1192 END DO 1193 ELSE 1194 DO j=j1,j2 1195 DO i=i1,i2 1196 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 1197 END DO 1198 END DO 1199 ENDIF 1200 1201 END SUBROUTINE Correct_field 1202 809 1203 #else 810 SUBROUTINE Subcalledbyagrif1204 SUBROUTINE Subcalledbyagrif 811 1205 !!---------------------------------------------------------------------- 812 1206 !! *** ROUTINE Subcalledbyagrif *** 813 1207 !!---------------------------------------------------------------------- 814 WRITE(*,*) 'Impossible to be here'815 END SUBROUTINE Subcalledbyagrif1208 WRITE(*,*) 'Impossible to be here' 1209 END SUBROUTINE Subcalledbyagrif 816 1210 #endif
Note: See TracChangeset
for help on using the changeset viewer.
