- Timestamp:
- 2020-11-10T12:57:08+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_12905_xios_ancil
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_12905_xios_ancil
- 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 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_12905_xios_ancil/src/NST/agrif_user.F90
r12489 r13766 11 11 END SUBROUTINE agrif_user 12 12 13 13 14 SUBROUTINE agrif_before_regridding 14 15 END SUBROUTINE agrif_before_regridding 15 16 17 16 18 SUBROUTINE Agrif_InitWorkspace 17 19 END SUBROUTINE Agrif_InitWorkspace 18 20 21 19 22 SUBROUTINE Agrif_InitValues 20 23 !!---------------------------------------------------------------------- … … 28 31 ! 29 32 ! !* Agrif initialization 30 CALL agrif_nemo_init31 CALL Agrif_InitValues_cont_dom32 33 CALL Agrif_InitValues_cont 33 34 # if defined key_top … … 40 41 END SUBROUTINE Agrif_initvalues 41 42 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 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 56 117 ! 57 118 IMPLICIT NONE 58 119 ! 59 120 INTEGER :: ind1, ind2, ind3 60 !!---------------------------------------------------------------------- 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 61 135 62 136 ! 1. Declaration of the type of variable which have to be interpolated 63 137 !--------------------------------------------------------------------- 64 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 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 70 157 ! 2. Type of interpolation 71 158 !------------------------- 72 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm ) 73 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear ) 74 75 ! 3. Location of interpolation 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 76 180 !----------------------------- 77 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 78 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 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/) ) 79 197 80 198 ! 4. Update type 81 199 !--------------- 82 200 # if defined UPD_HIGH 83 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting)84 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average )201 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting) 202 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average ) 85 203 #else 86 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average)87 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy)204 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average ) 205 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy ) 88 206 #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 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 97 218 USE agrif_oce_interp 98 219 USE agrif_oce_sponge 220 USE Agrif_Util 221 USE oce 99 222 USE dom_oce 100 USE oce 223 USE zdf_oce 224 USE nemogcm 225 USE agrif_oce 226 ! 227 USE lbclnk 101 228 USE lib_mpp 102 USE lbclnk 103 ! 104 IMPLICIT NONE 105 ! 106 INTEGER :: ji, jj 229 USE in_out_manager 230 ! 231 IMPLICIT NONE 232 ! 233 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 234 ! 107 235 LOGICAL :: check_namelist 108 236 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 109 #if defined key_vertical110 237 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 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 122 245 ! Build consistent parent bathymetry and number of levels 123 246 ! on the child grid 124 247 Agrif_UseSpecialValue = .FALSE. 125 ht0_parent( :,:) = 0._wp248 ht0_parent( :,:) = 0._wp 126 249 mbkt_parent(:,:) = 0 127 250 ! 128 CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 129 CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 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) 130 255 ! 131 256 ! Assume step wise change of bathymetry near interface 132 257 ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case 133 258 ! and no refinement 134 DO_2D _10_10135 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ) , mbkt_parent(ji,jj))136 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1) , mbkt_parent(ji,jj))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) ) 137 262 END_2D 138 263 IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN 139 DO_2D _10_10264 DO_2D( 1, 0, 1, 0 ) 140 265 hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) 141 266 hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) 142 267 END_2D 143 268 ELSE 144 DO_2D _10_10145 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )146 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )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) ) 147 272 END_2D 148 149 ENDIF 150 ! 151 CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 152 CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 153 zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 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 ) 154 280 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 155 zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 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 ) 156 285 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 157 #endif 158 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 342 !!---------------------------------------------------------------------- 343 !! *** ROUTINE Agrif_InitValues_cont *** 344 !! 345 !! ** Purpose :: Declaration of variables to be interpolated 346 !!---------------------------------------------------------------------- 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 367 368 ! 1. Declaration of the type of variable which have to be interpolated 369 !--------------------------------------------------------------------- 370 CALL agrif_declare_var 371 372 ! 2. First interpolations of potentially non zero fields 373 !------------------------------------------------------- 159 374 Agrif_SpecialValue = 0._wp 160 375 Agrif_UseSpecialValue = .TRUE. 161 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn)376 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn) 162 377 CALL Agrif_Sponge 163 378 tabspongedone_tsn = .FALSE. 164 379 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 165 ! reset ts (:,:,:,:,Krhs_a)to zero380 ! reset tsa to zero 166 381 ts(:,:,:,:,Krhs_a) = 0._wp 167 382 168 383 Agrif_UseSpecialValue = ln_spc_dyn 384 use_sign_north = .TRUE. 385 sign_north = -1. 169 386 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 170 387 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) … … 175 392 tabspongedone_v = .FALSE. 176 393 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 394 use_sign_north = .FALSE. 177 395 uu(:,:,:,Krhs_a) = 0._wp 178 396 vv(:,:,:,Krhs_a) = 0._wp … … 185 403 IF ( ln_dynspg_ts ) THEN 186 404 Agrif_UseSpecialValue = ln_spc_dyn 187 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 188 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 189 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 190 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 405 use_sign_north = .TRUE. 406 sign_north = -1. 407 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) ! must be called before unb_id to define ubdy 408 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) ! must be called before vnb_id to define vbdy 409 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb ) 410 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb ) 411 use_sign_north = .FALSE. 191 412 ubdy(:,:) = 0._wp 192 413 vbdy(:,:) = 0._wp 193 414 ENDIF 194 195 Agrif_UseSpecialValue = .FALSE. 196 197 ! 3. Some controls 415 Agrif_UseSpecialValue = .FALSE. 416 198 417 !----------------- 199 418 check_namelist = .TRUE. 200 419 201 420 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 421 ! Check free surface scheme 227 422 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& … … 251 446 STOP 252 447 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 ! 448 ENDIF 449 297 450 END SUBROUTINE Agrif_InitValues_cont 298 451 … … 314 467 ! 1. Declaration of the type of variable which have to be interpolated 315 468 !--------------------------------------------------------------------- 316 ind1 = nbghostcells317 ind2 = 1 + nbghostcells318 ind3 = 2 + nbghostcells469 ind1 = nbghostcells 470 ind2 = nn_hls + 2 + nbghostcells_x 471 ind3 = nn_hls + 2 + nbghostcells_y_s 319 472 # if defined key_vertical 320 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 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 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/),(/ind3,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/),(/ind3,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/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 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) 329 481 # else 330 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 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 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/),(/ind3,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/),(/ind3,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/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 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) 339 490 # 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 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) 343 506 # if defined key_vertical 344 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) 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) 346 510 # endif 347 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 350 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 351 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 352 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 353 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 354 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 355 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 356 357 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 358 359 IF( ln_zdftke.OR.ln_zdfgls ) THEN 360 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 361 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 362 # if defined key_vertical 363 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) 364 # else 365 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) 366 # endif 367 ENDIF 368 511 ENDIF 512 369 513 ! 2. Type of interpolation 370 514 !------------------------- 371 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 372 373 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 374 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 375 376 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 377 378 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 379 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 380 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 381 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 382 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 515 CALL Agrif_Set_bcinterp( tsn_id,interp =AGRIF_linear) 516 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 517 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 518 519 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 520 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 521 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 522 523 CALL Agrif_Set_bcinterp( sshn_id,interp =AGRIF_linear) 524 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 525 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 526 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 527 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 383 528 ! 384 529 ! > Divergence conserving alternative: … … 390 535 !< 391 536 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 ) 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) 403 542 404 543 ! 3. Location of interpolation … … 418 557 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 419 558 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/) ) 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/) ) 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 437 CALL Agrif_Set_Updatetype( tsn_id, update= Agrif_Update_Full_Weighting)438 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)439 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )440 441 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)442 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )443 CALL Agrif_Set_Updatetype( sshn_id,update= Agrif_Update_Full_Weighting)444 CALL Agrif_Set_Updatetype( e3t_id, update= Agrif_Update_Full_Weighting)445 446 IF( ln_zdftke.OR.ln_zdfgls ) THEN567 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 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 453 CALL Agrif_Set_Updatetype( tsn_id, update= AGRIF_Update_Average)454 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)455 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )456 457 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)458 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )459 CALL Agrif_Set_Updatetype( sshn_id,update= AGRIF_Update_Average)460 CALL Agrif_Set_Updatetype( e3t_id, update= AGRIF_Update_Average)461 462 IF( ln_zdftke.OR.ln_zdfgls ) THEN583 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 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 … … 471 601 472 602 #if defined key_si3 473 SUBROUTINE Agrif_InitValues_cont_ice603 SUBROUTINE Agrif_InitValues_cont_ice 474 604 !!---------------------------------------------------------------------- 475 605 !! *** ROUTINE Agrif_InitValues_cont_ice *** … … 484 614 ! 485 615 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 491 616 ! 617 !!---------------------------------------------------------------------- 492 618 ! Controls 493 619 … … 495 621 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 496 622 ! 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 623 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 498 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') 499 625 … … 512 638 END SUBROUTINE Agrif_InitValues_cont_ice 513 639 640 514 641 SUBROUTINE agrif_declare_var_ice 515 642 !!---------------------------------------------------------------------- … … 518 645 USE Agrif_Util 519 646 USE ice 520 USE par_oce, ONLY : nbghostcells 647 USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 521 648 ! 522 649 IMPLICIT NONE 523 650 ! 524 651 INTEGER :: ind1, ind2, ind3 652 INTEGER :: ipl 525 653 !!---------------------------------------------------------------------- 526 654 ! … … 532 660 ! 2,2 = two ghost lines 533 661 !------------------------------------------------------------------------------------- 534 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 ) 662 ind1 = nbghostcells 663 ind2 = nn_hls + 2 + nbghostcells_x 664 ind3 = nn_hls + 2 + nbghostcells_y_s 665 ipl = jpl*(9+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) 540 673 541 674 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 545 678 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 546 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 547 687 ! 3. Set location of interpolations 548 688 !---------------------------------- … … 550 690 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 551 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/)) 552 696 553 697 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 557 701 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 558 702 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 559 # else703 # else 560 704 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 561 705 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 562 706 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 563 # endif707 # endif 564 708 565 709 END SUBROUTINE agrif_declare_var_ice … … 584 728 USE agrif_top_interp 585 729 USE agrif_top_sponge 586 ! !730 ! 587 731 IMPLICIT NONE 588 732 ! … … 604 748 tabspongedone_trn = .FALSE. 605 749 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 606 ! reset ts (:,:,:,:,Krhs_a)to zero607 tr (:,:,:,:,Krhs_a) = 0._wp750 ! reset tsa to zero 751 tra(:,:,:,:) = 0._wp 608 752 609 753 ! 3. Some controls … … 613 757 IF( check_namelist ) THEN 614 758 ! Check time steps 615 IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN616 WRITE(cl_check1,*) Agrif_Parent(rn_Dt)617 WRITE(cl_check2,*) rn_Dt618 WRITE(cl_check3,*) rn_Dt*Agrif_Rhot()619 CALL ctl_stop( 'incompatible time step between grids', &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', & 620 764 & 'parent grid value : '//cl_check1 , & 621 765 & 'child grid value : '//cl_check2 , & 622 766 & 'value on child grid should be changed to & 623 767 & :'//cl_check3 ) 624 ENDIF625 626 ! Check run length627 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &768 ENDIF 769 770 ! Check run length 771 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 628 772 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 629 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1630 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()631 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' , & 632 776 & ' nit000 on fine grid will be change to : '//cl_check1, & 633 777 & ' nitend on fine grid will be change to : '//cl_check2 ) 634 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 635 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 636 ENDIF 637 638 ENDIF 639 ! 778 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 779 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 780 ENDIF 781 ENDIF 782 ! 640 783 END SUBROUTINE Agrif_InitValues_cont_top 641 784 … … 654 797 INTEGER :: ind1, ind2, ind3 655 798 !!---------------------------------------------------------------------- 656 799 !RB_CMEMS : declare here init for top 657 800 ! 1. Declaration of the type of variable which have to be interpolated 658 801 !--------------------------------------------------------------------- 659 ind1 = nbghostcells660 ind2 = 1 + nbghostcells661 ind3 = 2 + nbghostcells802 ind1 = nbghostcells 803 ind2 = nn_hls + 2 + nbghostcells_x 804 ind3 = nn_hls + 2 + nbghostcells_y_s 662 805 # 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)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) 665 808 # 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) 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) 668 812 # endif 669 813 … … 688 832 END SUBROUTINE agrif_declare_var_top 689 833 # endif 834 690 835 691 836 SUBROUTINE Agrif_detect( kg, ksizex ) … … 701 846 END SUBROUTINE Agrif_detect 702 847 848 703 849 SUBROUTINE agrif_nemo_init 704 850 !!---------------------------------------------------------------------- … … 707 853 USE agrif_oce 708 854 USE agrif_ice 855 USE dom_oce 709 856 USE in_out_manager 710 857 USE lib_mpp 711 ! !858 ! 712 859 IMPLICIT NONE 713 860 ! 714 861 INTEGER :: ios ! Local integer output status for namelist read 715 NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &862 NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 716 863 & ln_spc_dyn, ln_chk_bathy 717 864 !!-------------------------------------------------------------------------------------- … … 729 876 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 730 877 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 731 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 732 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 733 WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.' 734 WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.' 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 735 883 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 736 884 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 737 885 ENDIF 738 ! 739 ! 740 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 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. ' ) 741 906 ! 742 907 END SUBROUTINE agrif_nemo_init 743 908 909 744 910 # if defined key_mpp_mpi 745 746 911 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 747 912 !!---------------------------------------------------------------------- … … 756 921 ! 757 922 SELECT CASE( i ) 758 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 759 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 760 CASE DEFAULT 761 indglob = indloc 923 CASE(1) ; indglob = mig(indloc) 924 CASE(2) ; indglob = mjg(indloc) 925 CASE DEFAULT ; indglob = indloc 762 926 END SELECT 763 927 ! 764 928 END SUBROUTINE Agrif_InvLoc 765 929 930 766 931 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 767 932 !!---------------------------------------------------------------------- … … 776 941 !!---------------------------------------------------------------------- 777 942 ! 778 imin = nimppt(Agrif_Procrank+1) ! ?????779 jmin = njmppt(Agrif_Procrank+1) ! ?????780 imax = imin + jpi - 1781 jmax = jmin + jpj - 1943 imin = mig( 1 ) 944 jmin = mjg( 1 ) 945 imax = mig(jpi) 946 jmax = mjg(jpj) 782 947 ! 783 948 END SUBROUTINE Agrif_get_proc_info 784 949 950 785 951 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 786 952 !!---------------------------------------------------------------------- … … 803 969 # endif 804 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 805 1203 #else 806 1204 SUBROUTINE Subcalledbyagrif
Note: See TracChangeset
for help on using the changeset viewer.