Changeset 1300 for trunk/NEMO/NST_SRC
- Timestamp:
- 2009-02-09T16:36:04+01:00 (15 years ago)
- Location:
- trunk/NEMO/NST_SRC
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/NST_SRC/agrif_opa_interp.F90
r1156 r1300 1 1 MODULE agrif_opa_interp 2 #if defined key_agrif 2 #if defined key_agrif && ! defined key_off_tra 3 3 USE par_oce 4 4 USE oce -
trunk/NEMO/NST_SRC/agrif_opa_sponge.F90
r1156 r1300 2 2 3 3 Module agrif_opa_sponge 4 #if defined key_agrif 4 #if defined key_agrif && ! defined key_off_tra 5 5 USE par_oce 6 6 USE oce -
trunk/NEMO/NST_SRC/agrif_opa_update.F90
r1200 r1300 2 2 3 3 MODULE agrif_opa_update 4 #if defined key_agrif 4 #if defined key_agrif && ! defined key_off_tra 5 5 USE par_oce 6 6 USE oce … … 13 13 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 14 14 15 INTEGER :: nbcline15 INTEGER, PUBLIC :: nbcline = 0 16 16 17 17 !!---------------------------------------------------------------------- -
trunk/NEMO/NST_SRC/agrif_top_update.F90
r1271 r1300 15 15 PUBLIC Agrif_Update_Trc 16 16 17 INTEGER :: nbcline17 INTEGER, PUBLIC :: nbcline_trc = 0 18 18 19 19 !!---------------------------------------------------------------------- … … 39 39 Agrif_SpecialValueFineGrid = 0. 40 40 41 IF (MOD(nbcline ,nbclineupdate) == 0) THEN41 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 42 42 CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC) 43 43 ELSE … … 46 46 47 47 Agrif_UseSpecialValueInUpdate = .FALSE. 48 nbcline_trc = nbcline_trc + 1 48 49 #endif 49 50 50 51 END SUBROUTINE Agrif_Update_Trc 51 52 52 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2, before)53 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before) 53 54 !!--------------------------------------------- 54 55 !! *** ROUTINE UpdateTrc *** … … 56 57 # include "domzgr_substitute.h90" 57 58 58 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 59 REAL, DIMENSION(i1:i2,j1:j2,k1:k2, jptra), INTENT(inout) :: tabres59 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 60 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 60 61 LOGICAL, INTENT(in) :: before 61 62 62 INTEGER :: ji,jj,jk,jn 63 64 DO jn=1, jptra 63 INTEGER :: ji,jj,jk,jl 65 64 66 65 IF (before) THEN 67 DO jk=k1,k2 68 DO jj=j1,j2 69 DO ji=i1,i2 70 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 66 DO jl=l1,l2 67 DO jk=k1,k2 68 DO jj=j1,j2 69 DO ji=i1,i2 70 tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl) 71 ENDDO 71 72 ENDDO 72 73 ENDDO 73 74 ENDDO 74 75 ELSE 75 DO jk=k1,k2 76 DO jj=j1,j2 77 DO ji=i1,i2 78 IF (tabres(ji,jj,jk,jn).NE.0.) THEN 79 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 80 ENDIF 76 DO jl=l1,l2 77 DO jk=k1,k2 78 DO jj=j1,j2 79 DO ji=i1,i2 80 IF (tabres(ji,jj,jk,jl).NE.0.) THEN 81 trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk) 82 ENDIF 83 ENDDO 81 84 ENDDO 82 85 ENDDO 83 86 ENDDO 84 87 ENDIF 85 86 END DO87 88 88 89 END SUBROUTINE updateTRC -
trunk/NEMO/NST_SRC/agrif_user.F90
r1271 r1300 51 51 52 52 ! 53 #if ! defined key_off_tra 54 53 55 SUBROUTINE Agrif_InitValues 54 56 !!------------------------------------------ … … 310 312 CALL Agrif_Update_dyn(0) 311 313 314 #if defined key_top 315 nbcline_trc = 0 316 #endif 312 317 nbcline = 0 313 318 314 319 END SUBROUTINE Agrif_InitValues 315 320 ! 321 322 #else 323 SUBROUTINE Agrif_InitValues 324 !!------------------------------------------ 325 !! *** ROUTINE Agrif_InitValues *** 326 !! 327 !! ** Purpose :: Declaration of variables to 328 !! be interpolated 329 !!------------------------------------------ 330 USE Agrif_Util 331 USE oce 332 USE dom_oce 333 USE opa 334 USE trc 335 USE in_out_manager 336 USE agrif_top_update 337 USE agrif_top_interp 338 USE agrif_top_sponge 339 340 IMPLICIT NONE 341 342 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 343 LOGICAL check_namelist 344 345 ! 0. Initializations 346 !------------------- 347 #if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 348 jp_cfg = -1 ! set special value for jp_cfg on fine grids 349 cp_cfg = "default" 350 #endif 351 352 Call opa_init ! Initializations of each fine grid 353 Call agrif_opa_init 354 355 ! 1. Declaration of the type of variable which have to be interpolated 356 !--------------------------------------------------------------------- 357 Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 358 Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 359 Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 360 361 ! 2. Space directions for each variables 362 !--------------------------------------- 363 Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 364 Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 365 Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 366 367 ! 3. Type of interpolation 368 !------------------------- 369 Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 370 Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 371 372 ! 4. Location of interpolation 373 !----------------------------- 374 Call Agrif_Set_bc(trn,(/0,1/)) 375 Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 376 377 ! 5. Update type 378 !--------------- 379 Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 380 Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 381 382 ! 6. First interpolations of potentially non zero fields 383 !------------------------------------------------------- 384 Agrif_SpecialValue=0. 385 Agrif_UseSpecialValue = .TRUE. 386 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 387 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 388 Agrif_UseSpecialValue = .FALSE. 389 390 ! 7. Some controls 391 !----------------- 392 check_namelist = .true. 393 394 IF( check_namelist ) THEN 395 396 ! Check time steps 397 IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 398 WRITE(*,*) 'incompatible time step between grids' 399 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 400 WRITE(*,*) 'child grid value : ',nint(rdt) 401 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 402 STOP 403 ENDIF 404 405 ! Check run length 406 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 407 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 408 WRITE(*,*) 'incompatible run length between grids' 409 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 410 Agrif_Parent(nit000)+1),' time step' 411 WRITE(*,*) 'child grid value : ', & 412 (nitend-nit000+1),' time step' 413 WRITE(*,*) 'value on child grid should be : ', & 414 Agrif_IRhot() * (Agrif_Parent(nitend)- & 415 Agrif_Parent(nit000)+1) 416 STOP 417 ENDIF 418 419 ! Check coordinates 420 IF( ln_zps ) THEN 421 ! check parameters for partial steps 422 IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 423 WRITE(*,*) 'incompatible e3zps_min between grids' 424 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 425 WRITE(*,*) 'child grid :',e3zps_min 426 WRITE(*,*) 'those values should be identical' 427 STOP 428 ENDIF 429 IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 430 WRITE(*,*) 'incompatible e3zps_rat between grids' 431 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 432 WRITE(*,*) 'child grid :',e3zps_rat 433 WRITE(*,*) 'those values should be identical' 434 STOP 435 ENDIF 436 ENDIF 437 ! Check passive tracer cell 438 IF( ndttrc .ne. 1 ) THEN 439 WRITE(*,*) 'ndttrc should be equal to 1' 440 ENDIF 441 442 ENDIF 443 444 CALL Agrif_Update_trc(0) 445 nbcline_trc = 0 446 447 END SUBROUTINE Agrif_InitValues 448 #endif 316 449 317 450 SUBROUTINE Agrif_detect(g,sizex)
Note: See TracChangeset
for help on using the changeset viewer.