Changeset 3918 for trunk/NEMOGCM/NEMO/NST_SRC
- Timestamp:
- 2013-06-13T12:50:37+02:00 (11 years ago)
- Location:
- trunk/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r3916 r3918 334 334 !! we are in inside a new parent ice time step 335 335 !!----------------------------------------------------------------------- 336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 3d336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 337 337 INTEGER :: ji,jj,jn 338 338 !!----------------------------------------------------------------------- … … 345 345 adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) 346 346 ! interpolation of boundaries 347 ztab 3d(:,:,:) = 0.347 ztab(:,:,:) = 0. 348 348 Agrif_SpecialValue=-9999. 349 349 Agrif_UseSpecialValue = .TRUE. 350 CALL Agrif_Bc_variable( ztab 3d, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )350 CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 351 351 Agrif_SpecialValue=0. 352 352 Agrif_UseSpecialValue = .FALSE. … … 356 356 DO jj = 1, jpj 357 357 DO ji=1,2 358 adv_ice_oe(ji ,jj,jn,2) = ztab 3d(ji ,jj,jn)359 adv_ice_oe(ji+2,jj,jn,2) = ztab 3d(nlci-2+ji,jj,jn)358 adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn) 359 adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) 360 360 END DO 361 361 END DO … … 365 365 Do jj =1,2 366 366 DO ji = 1, jpi 367 adv_ice_sn(ji,jj ,jn,2) = ztab 3d(ji,jj ,jn)368 adv_ice_sn(ji,jj+2,jn,2) = ztab 3d(ji,nlcj-2+jj,jn)367 adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn) 368 adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) 369 369 END DO 370 370 END DO … … 384 384 INTEGER :: ji,jj,jn 385 385 REAL(wp) :: zalpha 386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 3d386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 387 387 !!----------------------------------------------------------------------- 388 388 ! … … 391 391 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 392 392 ! 393 ztab 3d(:,:,:) = 0.e0393 ztab(:,:,:) = 0.e0 394 394 DO jn =1,7 395 395 DO jj =1,2 396 396 DO ji = 1, jpi 397 ztab 3d(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2)398 ztab 3d(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)397 ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) 398 ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 399 399 END DO 400 400 END DO … … 404 404 DO jj = 1, jpj 405 405 DO ji=1,2 406 ztab 3d(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2)407 ztab 3d(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)408 END DO 409 END DO 410 END DO 411 ! 412 CALL parcoursT( ztab 3d(:,:, 1), frld )413 CALL parcoursT( ztab 3d(:,:, 2), hicif )414 CALL parcoursT( ztab 3d(:,:, 3), hsnif )415 CALL parcoursT( ztab 3d(:,:, 4), tbif(:,:,1) )416 CALL parcoursT( ztab 3d(:,:, 5), tbif(:,:,2) )417 CALL parcoursT( ztab 3d(:,:, 6), tbif(:,:,3) )418 CALL parcoursT( ztab 3d(:,:, 7), qstoif )406 ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 407 ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 408 END DO 409 END DO 410 END DO 411 ! 412 CALL parcoursT( ztab(:,:, 1), frld ) 413 CALL parcoursT( ztab(:,:, 2), hicif ) 414 CALL parcoursT( ztab(:,:, 3), hsnif ) 415 CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) 416 CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) 417 CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) 418 CALL parcoursT( ztab(:,:, 7), qstoif ) 419 419 ! 420 420 END SUBROUTINE agrif_trp_lim2 -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r3916 r3918 34 34 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 35 35 REAL(wp), POINTER, DIMENSION(:,: ) :: ztu, ztv 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 4d36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 37 37 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 38 38 39 39 #if defined SPONGE 40 40 CALL wrk_alloc( jpi, jpj, ztu, ztv ) 41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab 4d, tsbdiff )41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 42 42 43 43 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 45 45 Agrif_SpecialValue=0. 46 46 Agrif_UseSpecialValue = .TRUE. 47 ztab 4d= 0.e048 CALL Agrif_Bc_Variable(ztab 4d, tsa_id,calledweight=timecoeff,procname=interptsn)47 ztab = 0.e0 48 CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 49 49 Agrif_UseSpecialValue = .FALSE. 50 50 51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab 4d(:,:,:,:)51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 52 52 53 53 CALL Agrif_Sponge … … 80 80 81 81 CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab 4d, tsbdiff )82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 83 83 #endif 84 84 … … 95 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 96 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 3d97 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 98 98 99 99 #if defined SPONGE 100 CALL wrk_alloc( jpi, jpj, jpk, ztab 3d, ubdiff, vbdiff, rotdiff, hdivdiff )100 CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 101 101 102 102 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 104 104 Agrif_SpecialValue=0. 105 105 Agrif_UseSpecialValue = ln_spc_dyn 106 ztab 3d= 0.e0107 CALL Agrif_Bc_Variable(ztab 3d, ua_id,calledweight=timecoeff,procname=interpun)106 ztab = 0.e0 107 CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 108 108 Agrif_UseSpecialValue = .FALSE. 109 109 110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab 3d(:,:,:) ) * umask(:,:,:)111 112 ztab 3d= 0.e0110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 111 112 ztab = 0.e0 113 113 Agrif_SpecialValue=0. 114 114 Agrif_UseSpecialValue = ln_spc_dyn 115 CALL Agrif_Bc_Variable(ztab 3d, va_id,calledweight=timecoeff,procname=interpvn)115 CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn) 116 116 Agrif_UseSpecialValue = .FALSE. 117 117 118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab 3d(:,:,:) ) * vmask(:,:,:)118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 119 119 120 120 CALL Agrif_Sponge … … 174 174 END DO ! End of slab 175 175 ! ! =============== 176 CALL wrk_dealloc( jpi, jpj, jpk, ztab 3d, ubdiff, vbdiff, rotdiff, hdivdiff )176 CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 177 177 #endif 178 178 -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r3916 r3918 32 32 !! 33 33 INTEGER, INTENT(in) :: kt 34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 4d34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 35 35 36 36 37 37 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 38 #if defined TWO_WAY 39 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab 4d)39 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 40 40 41 41 Agrif_UseSpecialValueInUpdate = .TRUE. … … 43 43 44 44 IF (MOD(nbcline,nbclineupdate) == 0) THEN 45 CALL Agrif_Update_Variable(ztab 4d,tsn_id, procname=updateTS)46 ELSE 47 CALL Agrif_Update_Variable(ztab 4d,tsn_id,locupdate=(/0,2/), procname=updateTS)45 CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 46 ELSE 47 CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 48 48 ENDIF 49 49 50 50 Agrif_UseSpecialValueInUpdate = .FALSE. 51 51 52 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab 4d)52 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 53 53 #endif 54 54 … … 62 62 INTEGER, INTENT(in) :: kt 63 63 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 3d64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 65 65 66 66 … … 68 68 #if defined TWO_WAY 69 69 CALL wrk_alloc( jpi, jpj, ztab2d ) 70 CALL wrk_alloc( jpi, jpj, jpk, ztab 3d)70 CALL wrk_alloc( jpi, jpj, jpk, ztab ) 71 71 72 72 IF (mod(nbcline,nbclineupdate) == 0) THEN 73 CALL Agrif_Update_Variable(ztab 3d,un_id,procname = updateU)74 CALL Agrif_Update_Variable(ztab 3d,vn_id,procname = updateV)75 ELSE 76 CALL Agrif_Update_Variable(ztab 3d,un_id,locupdate=(/0,1/),procname = updateU)77 CALL Agrif_Update_Variable(ztab 3d,vn_id,locupdate=(/0,1/),procname = updateV)73 CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 74 CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 75 ELSE 76 CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 77 CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV) 78 78 ENDIF 79 79 … … 89 89 90 90 CALL wrk_dealloc( jpi, jpj, ztab2d ) 91 CALL wrk_dealloc( jpi, jpj, jpk, ztab 3d)91 CALL wrk_dealloc( jpi, jpj, jpk, ztab ) 92 92 93 93 !Done in step
Note: See TracChangeset
for help on using the changeset viewer.