- Timestamp:
- 2017-11-17T17:19:55+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7761 r8741 1 #undef UPD_HIGH /* MIX HIGH UPDATE */ 1 2 #if defined key_agrif 2 3 !!---------------------------------------------------------------------- … … 88 89 # endif 89 90 ! 91 nbcline = 0 92 #if defined key_top 93 nbcline_trc = 0 94 #endif 95 ! 96 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) CALL agrif_Update_ini() 97 98 Agrif_UseSpecialValueInUpdate = .FALSE. 99 90 100 END SUBROUTINE Agrif_initvalues 91 101 … … 144 154 CALL Agrif_Set_bc(e2v_id,(/0,0/)) 145 155 146 ! 5. Update type156 ! 4. Update type 147 157 !--------------- 158 # if defined UPD_HIGH 159 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 160 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 161 #else 148 162 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 149 163 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 150 151 ! High order updates 152 ! CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 153 ! CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 154 ! 164 #endif 165 155 166 END SUBROUTINE agrif_declare_var_dom 156 167 … … 175 186 ! 176 187 LOGICAL :: check_namelist 177 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 188 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 178 189 !!---------------------------------------------------------------------- 179 190 … … 205 216 Agrif_UseSpecialValue = .TRUE. 206 217 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 218 hbdy_w(:) = 0.e0 ; hbdy_e(:) = 0.e0 ; hbdy_n(:) = 0.e0 ; hbdy_s(:) = 0.e0 219 ssha(:,:) = 0.e0 207 220 208 221 IF ( ln_dynspg_ts ) THEN … … 212 225 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 213 226 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 214 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0215 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0216 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0217 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0227 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 228 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 229 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 230 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 218 231 ENDIF 219 232 … … 234 247 WRITE(cl_check2,*) NINT(rdt) 235 248 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 236 CALL ctl_stop( ' incompatible time step between ocean grids', &249 CALL ctl_stop( 'Incompatible time step between ocean grids', & 237 250 & 'parent grid value : '//cl_check1 , & 238 251 & 'child grid value : '//cl_check2 , & … … 245 258 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 246 259 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 247 CALL ctl_warn( ' incompatible run length between grids', &248 & ' nit000 on fine grid will be changeto : '//cl_check1, &249 & ' nitend on fine grid will be changeto : '//cl_check2 )260 CALL ctl_warn( 'Incompatible run length between grids' , & 261 & 'nit000 on fine grid will be changed to : '//cl_check1, & 262 & 'nitend on fine grid will be changed to : '//cl_check2 ) 250 263 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 251 264 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 252 265 ENDIF 253 266 254 ! Check coordinates255 !SF IF( ln_zps ) THEN256 !SF ! check parameters for partial steps257 !SF IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN258 !SF WRITE(*,*) 'incompatible e3zps_min between grids'259 !SF WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)260 !SF WRITE(*,*) 'child grid :',e3zps_min261 !SF WRITE(*,*) 'those values should be identical'262 !SF STOP263 !SF ENDIF264 !SF IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN265 !SF WRITE(*,*) 'incompatible e3zps_rat between grids'266 !SF WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)267 !SF WRITE(*,*) 'child grid :',e3zps_rat268 !SF WRITE(*,*) 'those values should be identical'269 !SF STOP270 !SF ENDIF271 !SF ENDIF272 273 267 ! Check free surface scheme 274 268 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 275 269 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 276 WRITE(*,*) 'incompatible free surface scheme between grids' 277 WRITE(*,*) 'parent grid ln_dynspg_ts :', Agrif_Parent(ln_dynspg_ts ) 278 WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 279 WRITE(*,*) 'child grid ln_dynspg_ts :', ln_dynspg_ts 280 WRITE(*,*) 'child grid ln_dynspg_exp :', ln_dynspg_exp 281 WRITE(*,*) 'those logicals should be identical' 270 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 271 WRITE(cl_check2,*) ln_dynspg_ts 272 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 273 WRITE(cl_check4,*) ln_dynspg_exp 274 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 275 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 276 & 'child grid ln_dynspg_ts :'//cl_check2 , & 277 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 278 & 'child grid ln_dynspg_exp :'//cl_check4 , & 279 & 'those logicals should be identical' ) 280 STOP 281 ENDIF 282 283 ! Check if identical linear free surface option 284 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 285 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 286 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 287 WRITE(cl_check2,*) ln_linssh 288 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 289 & 'parent grid ln_linssh :'//cl_check1 , & 290 & 'child grid ln_linssh :'//cl_check2 , & 291 & 'those logicals should be identical' ) 282 292 STOP 283 293 ENDIF … … 306 316 ENDIF 307 317 ! 308 ! Do update at initialisation because not done before writing restarts 309 ! This would indeed change boundary conditions values at initial time 310 ! hence produce restartability issues. 311 ! Note that update below is recursive (with lk_agrif_doupd=T): 312 ! 313 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 314 ! or the absolute maximum nesting level...TBC 315 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 316 ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 317 CALL Agrif_Update_tra() 318 CALL Agrif_Update_dyn() 319 ENDIF 320 ! 318 END SUBROUTINE Agrif_InitValues_cont 319 320 RECURSIVE SUBROUTINE Agrif_Update_ini( ) 321 !!---------------------------------------------------------------------- 322 !! *** ROUTINE agrif_Update_ini *** 323 !! 324 !! ** Purpose :: Recursive update done at initialization 325 !!---------------------------------------------------------------------- 326 USE dom_oce 327 USE agrif_opa_update 328 #if defined key_top 329 USE agrif_top_update 330 #endif 331 ! 332 IMPLICIT NONE 333 !!---------------------------------------------------------------------- 334 ! 335 IF (Agrif_Root()) RETURN 336 ! 337 IF (.NOT.ln_linssh) CALL Agrif_Update_vvl() 338 CALL Agrif_Update_tra() 339 #if defined key_top 340 CALL Agrif_Update_Trc() 341 #endif 342 CALL Agrif_Update_dyn() 321 343 # if defined key_zdftke 322 CALL Agrif_Update_tke(0) 323 # endif 324 ! 325 Agrif_UseSpecialValueInUpdate = .FALSE. 326 nbcline = 0327 lk_agrif_doupd = .FALSE.328 !329 END SUBROUTINE Agrif_InitValues_cont 330 344 ! JC remove update because this precludes from perfect restartability 345 !! CALL Agrif_Update_tke() 346 # endif 347 348 CALL Agrif_ChildGrid_To_ParentGrid() 349 CALL Agrif_Update_ini() 350 CALL Agrif_ParentGrid_To_ChildGrid() 351 352 END SUBROUTINE agrif_update_ini 331 353 332 354 SUBROUTINE agrif_declare_var … … 371 393 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 372 394 373 # if defined key_zdftke 374 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/), en_id)375 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/),avt_id)376 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/),avm_id)395 # if defined key_zdftke || defined key_zdfgls 396 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 397 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 398 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avm_id) 377 399 # endif 378 400 … … 400 422 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 401 423 402 # if defined key_zdftke 424 # if defined key_zdftke || defined key_zdfgls 403 425 CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 404 426 # endif … … 411 433 CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 412 434 413 ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))414 ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))415 ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))416 435 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 417 436 CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) … … 428 447 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 429 448 449 # if defined key_zdftke || defined key_zdfgls 450 CALL Agrif_Set_bc(avm_id ,(/0,1/)) 451 # endif 452 453 ! 4. Update type 454 !--------------- 455 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 456 457 # if defined UPD_HIGH 458 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 459 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 460 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 461 462 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 463 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 464 CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 465 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 466 430 467 # if defined key_zdftke 431 CALL Agrif_Set_bc(avm_id ,(/0,1/)) 432 # endif 433 434 ! 5. Update type 435 !--------------- 468 CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 469 CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 470 CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 471 # endif 472 473 #else 436 474 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 437 438 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)439 440 475 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 441 476 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 442 477 443 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)444 445 478 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 446 479 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 480 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 481 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 447 482 448 483 # if defined key_zdftke … … 452 487 # endif 453 488 454 ! High order updates 455 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 456 ! CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 457 ! CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 458 ! 459 ! CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 460 ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 461 ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 462 489 #endif 463 490 ! 464 491 END SUBROUTINE agrif_declare_var … … 733 760 ENDIF 734 761 735 ! Check coordinates736 IF( ln_zps ) THEN737 ! check parameters for partial steps738 IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN739 WRITE(*,*) 'incompatible e3zps_min between grids'740 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)741 WRITE(*,*) 'child grid :',e3zps_min742 WRITE(*,*) 'those values should be identical'743 STOP744 ENDIF745 IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN746 WRITE(*,*) 'incompatible e3zps_rat between grids'747 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)748 WRITE(*,*) 'child grid :',e3zps_rat749 WRITE(*,*) 'those values should be identical'750 STOP751 ENDIF752 762 ENDIF 753 763 ! Check passive tracer cell … … 756 766 ENDIF 757 767 ENDIF 758 759 CALL Agrif_Update_trc(0)760 !761 Agrif_UseSpecialValueInUpdate = .FALSE.762 nbcline_trc = 0763 768 ! 764 769 END SUBROUTINE Agrif_InitValues_cont_top … … 792 797 !----------------------------- 793 798 CALL Agrif_Set_bc(trn_id,(/0,1/)) 794 ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))795 799 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 796 800 797 ! 5. Update type801 ! 4. Update type 798 802 !--------------- 803 # if defined UPD_HIGH 804 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 805 #else 799 806 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 800 801 ! Higher order update 802 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 803 807 #endif 804 808 ! 805 809 END SUBROUTINE agrif_declare_var_top … … 866 870 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 867 871 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 872 ! Check update frequency 873 IF (MOD((nitend-nit000+1), nbclineupdate).NE.0 ) CALL ctl_stop('number of time steps should be a multiple of nn_cln_update') 868 874 ! 869 875 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') … … 878 884 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 879 885 !!---------------------------------------------------------------------- 880 !! *** ROUTINE Agrif_ detect***886 !! *** ROUTINE Agrif_InvLoc *** 881 887 !!---------------------------------------------------------------------- 882 888 USE dom_oce
Note: See TracChangeset
for help on using the changeset viewer.
