Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 67 additions and 69 deletions
tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -80,14 +80,14 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! DO_2D( 1, 1, 1, 1 )
! ! longitude
plamt(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
plamu(ji,jj) = zfact * ( 0.5 + REAL( mig0(ji)-1 , wp ) )
plamt(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamu(ji,jj) = zfact * ( 0.5 + REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude
pphit(ji,jj) = zfact2 * ( REAL( mjg0(jj)-1 , wp ) )
pphit(ji,jj) = zfact2 * ( REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg0(jj)-1 , wp ) )
pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
......
tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
View file @ 3efbcb17
......@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
USE dom_oce , ONLY: glamt ! ocean space and time domain
USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
......@@ -105,10 +104,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
DO ji = mi0(1), mi1(1) ! first row of global domain only
DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
zhu(:,1) = zhu(:,2)
......
tests/BENCH/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -75,15 +75,15 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.5
z2d(ji,jj) = 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
z2d(ji,jj) = 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
END_2D
!
! Position coordinates (in grid points)
! ==========
DO_2D( 0, 0, 0, 0 )
zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zti * (1. + 1.0e-5 * z2d(ji,jj) )
plamu(ji,jj) = ( zti + 0.5_wp ) * (1. + 2.0e-5 * z2d(ji,jj) )
......
tests/BENCH/MY_SRC/usrdef_istate.F90
View file @ 3efbcb17
......@@ -65,7 +65,7 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.05
z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
......@@ -108,7 +108,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh'
!
DO_2D( 0, 0, 0, 0 ) ! sea level: +/- 0.05 m
pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions
......
tests/BENCH/MY_SRC/usrdef_sbc.F90
View file @ 3efbcb17
......@@ -104,12 +104,12 @@ CONTAINS
! define unique value on each point. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 )
zztmp = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
zztmp = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
utau_ice(ji,jj) = 0.1_wp + zztmp
vtau_ice(ji,jj) = 0.1_wp + zztmp
END_2D
CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'T', -1., vtau_ice, 'T', -1. )
#endif
!
END SUBROUTINE usrdef_sbc_ice_tau
......@@ -125,7 +125,7 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness
!!
REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing
REAL(wp), DIMENSION(A2D(0)) :: zsnw ! snw distribution after wind blowing
!!---------------------------------------------------------------------
#if defined key_si3
!
......@@ -150,9 +150,9 @@ CONTAINS
emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
qevap_ice(:,:,:) = 0._wp
qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3
qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp
qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
qprec_ice(:,:) = rhos * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! in J/m3
qemp_oce (:,:) = - emp_oce(:,:) * sst_m(A2D(0)) * rcp
qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! solid precip (only)
! total fluxes
emp_tot (:,:) = emp_ice + emp_oce
......
tests/BENCH/MY_SRC/usrdef_zgr.F90
View file @ 3efbcb17
......@@ -197,14 +197,14 @@ CONTAINS
!
!!$ IF( c_NFtype == 'T' ) THEN ! add a small island in the upper corners to avoid model instabilities...
!!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
!!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
!!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
!!$ z2d(mi0( nn_hls,nn_hls):mi1( nn_hls+2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ z2d(mi0(jpiglo-nn_hls,nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2),nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ z2d(mi0(jpiglo/2 ,nn_hls):mi1( jpiglo/2 +2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ ENDIF
!!$ !
IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points
z2d(mi0(nn_hls+1):mi1(nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
z2d(mi0(jpiglo/2):mi1(jpiglo/2),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
z2d(mi0(nn_hls+1,nn_hls):mi1(nn_hls+1,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
z2d(mi0(jpiglo/2,nn_hls):mi1(jpiglo/2,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
ENDIF
!
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries)
......
tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
View file @ 3efbcb17
......@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
......
tests/CANAL/EXPREF/file_def_nemo-oce.xml
View file @ 3efbcb17
......@@ -20,15 +20,15 @@
<field field_ref="ssrelpotvor" />
<field field_ref="saltc" />
<field field_ref="salt2c" />
<field field_ref="utau" />
<field field_ref="vtau" />
</file>
<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
<field field_ref="utau" />
<field field_ref="uoce" />
</file>
<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
<field field_ref="vtau" />
<field field_ref="voce" />
</file>
......
tests/CANAL/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -88,8 +88,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
......
tests/DIA_GPU/EXPREF/file_def_nemo-oce.xml
View file @ 3efbcb17
......@@ -34,6 +34,8 @@
<field field_ref="qt_oce" name="qt_oce" />
<field field_ref="saltflx" name="sfx" />
<field field_ref="taum" name="taum" />
<field field_ref="utau" name="tauuo" />
<field field_ref="vtau" name="tauvo" />
<field field_ref="wspd" name="windsp" />
<field field_ref="precip" name="precip" />
<!-- ice and snow -->
......@@ -44,7 +46,6 @@
<field field_ref="e3u" />
<field field_ref="ssu" name="uos" />
<field field_ref="uoce" name="uo" operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
<field field_ref="utau" name="tauuo" />
<field field_ref="uocetr_eff" name="uocetr_eff" />
<!-- available with diaar5 -->
<field field_ref="u_masstr" name="vozomatr" />
......@@ -56,7 +57,6 @@
<field field_ref="e3v" />
<field field_ref="ssv" name="vos" />
<field field_ref="voce" name="vo" operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
<field field_ref="vtau" name="tauvo" />
<field field_ref="vocetr_eff" name="vocetr_eff" />
<!-- available with diaar5 -->
<field field_ref="v_masstr" name="vomematr" />
......
tests/DIA_GPU/MY_SRC/stpctl.F90
View file @ 3efbcb17
......@@ -232,7 +232,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
......
tests/DOME/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -93,8 +93,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji) - 1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg0(jj) - 1, wp ) ! start at j=0 in the global grid without halos
zti = REAL( mig(ji,0) - 1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg(jj,0) - 1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
......
tests/DOME/MY_SRC/usrdef_istate.F90
View file @ 3efbcb17
......@@ -105,10 +105,10 @@ CONTAINS
! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2
! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2
! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk)
IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-2 ) ) THEN
IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-2 ) ) THEN
pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk)
ENDIF
IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-1 ) ) THEN
IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-1 ) ) THEN
pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk)
pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk)
ENDIF
......
tests/DOME/MY_SRC/usrdef_zgr.F90
View file @ 3efbcb17
......@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
USE dom_oce , ONLY: glamt, gphit ! ocean space and time domain
USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
......
tests/DONUT/EXPREF/file_def_nemo-oce.xml
View file @ 3efbcb17
......@@ -28,6 +28,8 @@
<field field_ref="qt_oce" name="qt_oce" />
<field field_ref="saltflx" name="sfx" />
<field field_ref="taum" name="taum" />
<field field_ref="utau" name="tauuo" />
<field field_ref="vtau" name="tauvo" />
<field field_ref="wspd" name="windsp" />
<field field_ref="precip" name="precip" />
</file>
......@@ -36,14 +38,12 @@
<field field_ref="e3u" />
<field field_ref="ssu" name="uos" />
<field field_ref="uoce" name="uo" operation="instant" freq_op="1d" > @uoce_e3u / @e3u </field>
<field field_ref="utau" name="tauuo" />
</file>
<file id="file13" name_suffix="_grid_V" description="ocean V grid variables" >
<field field_ref="e3v" />
<field field_ref="ssv" name="vos" />
<field field_ref="voce" name="vo" operation="instant" freq_op="1d" > @voce_e3v / @e3v </field>
<field field_ref="vtau" name="tauvo" />
</file>
</file_group>
......
tests/ICB/MY_SRC/usrdef_nam.F90
View file @ 3efbcb17
......@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
......
tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -78,8 +78,8 @@ CONTAINS
zphi0 = -REAL(Nj0glo, wp) * 0.5 * 1.e-3 * rn_dy
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
......
tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -90,8 +90,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
......@@ -110,19 +110,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
......
tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
View file @ 3efbcb17
......@@ -96,8 +96,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji)-1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg0(jj)-1, wp ) ! start at j=0 in the global grid without halos
zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
......@@ -116,19 +116,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
......
tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
View file @ 3efbcb17
......@@ -18,7 +18,7 @@ MODULE usrdef_sbc
USE sbc_ice ! Surface boundary condition: ice fields
USE phycst ! physical constants
USE ice, ONLY : at_i_b, a_i_b
USE icethd_dh ! for CALL ice_thd_snwblow
!! USE icethd_dh ! for CALL ice_thd_snwblow
USE sbc_phy, ONLY : pp_cldf
!
USE in_out_manager ! I/O manager
......@@ -33,6 +33,8 @@ MODULE usrdef_sbc
PUBLIC usrdef_sbc_ice_tau ! routine called by icestp.F90 for ice dynamics
PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: usrdef_sbc.F90 14273 2021-01-06 10:57:45Z smasson $
......@@ -109,8 +111,8 @@ CONTAINS
!!
INTEGER :: jl
REAL(wp) :: zfr1, zfr2 ! local variables
REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing
REAL(wp), DIMENSION(jpi,jpj) :: ztri
REAL(wp), DIMENSION(A2D(0)) :: zsnw ! snw distribution after wind blowing
REAL(wp), DIMENSION(A2D(0)) :: ztri
!!---------------------------------------------------------------------
!
IF( kt==nit000 .AND. lwp) WRITE(numout,*)' usrdef_sbc_ice : ICE_AGRIF case: NO flux forcing'
......@@ -134,9 +136,9 @@ CONTAINS
emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
qevap_ice(:,:,:) = 0._wp
qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3
qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp
qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
qprec_ice(:,:) = rhos * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! in J/m3
qemp_oce (:,:) = - emp_oce(:,:) * sst_m(A2D(0)) * rcp
qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! solid precip (only)
! total fluxes
emp_tot (:,:) = emp_ice + emp_oce
......@@ -148,11 +150,11 @@ CONTAINS
ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm
!
DO jl = 1, jpl
WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm
WHERE ( phs(A2D(0),jl) <= 0._wp .AND. phi(A2D(0),jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(A2D(0),jl) * 10._wp ) )
ELSEWHERE( phs(A2D(0),jl) <= 0._wp .AND. phi(A2D(0),jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm
qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:)
ELSEWHERE ! zero when hs>0
ELSEWHERE ! zero when hs>0
qtr_ice_top(:,:,jl) = 0._wp
END WHERE
ENDDO
......