# Changeset 12844

Ignore:
Timestamp:
2020-05-01T12:57:50+02:00 (9 months ago)
Message:

r12581_ticket2418: merge with trunk@12843, see #2418

Location:
NEMO/branches/2020/r12581_ticket2418
Files:
1 deleted
43 edited

Unmodified
Removed
• ## NEMO/branches/2020/r12581_ticket2418/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90

 r12377 PUBLIC   usr_def_zgr        ! called by domzgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) pe3vw(:,:,jk) = pe3w_1d (jk) END DO DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points DO ji = 1, jpi ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) END DO END DO ! bottom scale factors and depth at T- and W-points DO_2D_11_11 ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) END_2D !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points !                                   ! usually Computed as the minimum of neighbooring scale factors
• ## NEMO/branches/2020/r12581_ticket2418/src/ABL/ablmod.F90

 r12489 !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< !                            !  8 *** Swap time indices for the next timestep !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< nt_n = 1 + MOD( kt  , 2) nt_a = 1 + MOD( kt+1, 2) ! !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< nt_n = 1 + MOD( nt_n, 2) nt_a = 1 + MOD( nt_a, 2) ! !--------------------------------------------------------------------------------------------------- END SUBROUTINE abl_stp
• ## NEMO/branches/2020/r12581_ticket2418/src/ABL/par_abl.F90

 r12489 LOGICAL , PUBLIC            ::   ln_smth_pblh   !: smoothing of atmospheric PBL height LOGICAL           , PUBLIC ::   ln_rstart_abl    !: (de)activate abl restart CHARACTER(len=256), PUBLIC ::   cn_ablrst_in     !: suffix of abl restart name (input) CHARACTER(len=256), PUBLIC ::   cn_ablrst_out    !: suffix of abl restart name (output)
• ## NEMO/branches/2020/r12581_ticket2418/src/ABL/sbcabl.F90

 r12549 LOGICAL            ::   lluldl NAMELIST/namsbc_abl/ cn_dir, cn_dom, cn_ablrst_in, cn_ablrst_out,           & &                 cn_ablrst_indir, cn_ablrst_outdir,                     & &                 cn_ablrst_indir, cn_ablrst_outdir, ln_rstart_abl,      & &                 ln_hpgls_frc, ln_geos_winds, nn_dyn_restore,           & &                 rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max,   & ! Initialize the time index for now time (nt_n) and after time (nt_a) nt_n = 1 + MOD( nit000  , 2) nt_a = 1 + MOD( nit000+1, 2) nt_n = 1; nt_a = 2 ! initialize ABL from data or restart IF( ln_rstart ) THEN IF( ln_rstart_abl ) THEN CALL abl_rst_read ELSE ENDIF rhoa(:,:) = rho_air( tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), sf(jp_slp)%fnow(:,:,1) ) !!GS: rhoa must be (re)computed here here to avoid division by zero in blk_ice_1 (TBI) END SUBROUTINE sbc_abl_init CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step !!------------------------------------------------------------------------------------------- !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields !!------------------------------------------------------------------------------------------- CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out #if defined key_si3 CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out #endif !!------------------------------------------------------------------------------------------- !! 3 - Advance ABL variables from now (n) to after (n+1) !!------------------------------------------------------------------------------------------- CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in &              zcd_du, zsen, zevp,                                 &   !   <=> in/out &              wndm, utau, vtau, taum                              &   !   =>> out #if defined key_si3 &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in &            , utau_ice, vtau_ice                                  &   !   =>> out #endif &                                                                  ) !!------------------------------------------------------------------------------------------- !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since !!                                                                time swap is done in abl_stp !!------------------------------------------------------------------------------------------- CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & &            tsk_m, zsen, zevp                                ) CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file #if defined key_si3 ! Avoid a USE abl in icesbc module sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) #endif IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN !!------------------------------------------------------------------------------------------- !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields !!------------------------------------------------------------------------------------------- CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out #if defined key_si3 CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out #endif !!------------------------------------------------------------------------------------------- !! 3 - Advance ABL variables from now (n) to after (n+1) !!------------------------------------------------------------------------------------------- CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in &              zcd_du, zsen, zevp,                                 &   !   <=> in/out &              wndm, utau, vtau, taum                              &   !   =>> out #if defined key_si3 &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in &            , utau_ice, vtau_ice                                  &   !   =>> out #endif &                                                                  ) !!------------------------------------------------------------------------------------------- !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since !!                                                                time swap is done in abl_stp !!------------------------------------------------------------------------------------------- CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & &            tsk_m, zsen, zevp                                ) CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file #if defined key_si3 ! Avoid a USE abl in icesbc module sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) #endif END IF END SUBROUTINE sbc_abl
• ## NEMO/branches/2020/r12581_ticket2418/src/ICE/iceistate.F90

 r12655 ! ! -- mandatory fields -- ! zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) ! -- optional fields -- ! &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) ! zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) ! ! change the switch for the following
• ## NEMO/branches/2020/r12581_ticket2418/src/OCE/ASM/asminc.F90

 r12489 IF ( kt == nitdin_r ) THEN ! l_1st_euler = 0              ! Force Euler forward step l_1st_euler = .TRUE.              ! Force Euler forward step ! ! Sea-ice : SI3 case
• ## NEMO/branches/2020/r12581_ticket2418/src/OCE/DOM/domvvl.F90

 r12489 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) DO ji = 1, jpi DO jj = 1, jpj IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) ENDIF END DO END DO DO_2D_11_11 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) ENDIF END_2D ! ELSE

• ## NEMO/branches/2020/r12581_ticket2418/src/OCE/SBC/sbcblk.F90

 r12655 IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp !! FL do we need this multiplication by tmask ... ??? DO_2D_11_11 zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) zztmp = zU_zu(ji,jj) wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) psen(ji,jj)   = zztmp * zch_oce(ji,jj) pevp(ji,jj)   = zztmp * zce_oce(ji,jj) rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) END_2D ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation ! local scalars ( place there for vector optimisation purposes) !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI) zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:)
• ## NEMO/branches/2020/r12581_ticket2418/src/OCE/USR/usrdef_zgr.F90

 r12377 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) ! k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere ! k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere

• ## NEMO/branches/2020/r12581_ticket2418/src/OFF/nemogcm.F90

 r12835 USE usrdef_nam     ! user defined configuration USE eosbn2         ! equation of state            (eos bn2 routine) USE bdy_oce,  ONLY : ln_bdy USE bdyini         ! open boundary cond. setting       (bdy_init routine) !              ! ocean physics USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) ! Initialise time level indices Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa !                             !-------------------------------! CALL     sbc_init( Nbb, Nnn, Naa )    ! Forcings : surface module CALL     bdy_init    ! Open boundaries initialisation !                                      ! Tracer physics USE zdf_oce,   ONLY : zdf_oce_alloc USE trc_oce,   ONLY : trc_oce_alloc USE bdy_oce,   ONLY : bdy_oce_alloc ! INTEGER :: ierr ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization) ! CALL mpp_sum( 'nemogcm', ierr )
• ## NEMO/branches/2020/r12581_ticket2418/src/TOP/PISCES/P4Z/p4zmeso.F90

 r12377 REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof zgrazing2(ji,jj,jk) = zgraztotc !    Mesozooplankton efficiency !    -------------------------- ! Mesozooplankton efficiency. ! We adopt a formulation proposed by Mitra et al. (2007) ! The gross growth efficiency is controled by the most limiting nutrient. ! Growth is also further decreased when the food quality is poor. This is currently ! hard coded : it can be decreased by up to 50% (zepsherq) ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and ! Fulton, 2012) ! ----------------------------------------------------------------------------------- zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) zbeta     = MAX(0., (epsher2 - epsher2min) ) zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) zepsherv  = zepsherf * zepshert zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) zepsherv  = zepsherf * zepshert * zepsherq zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) zgrapoc2  = zgraztotc * unass2 !   Update the arrays TRA which contain the biological sources and sinks
• ## NEMO/branches/2020/r12581_ticket2418/src/TOP/PISCES/P4Z/p4zmicro.F90

 r12377 REAL(wp) :: zgraze  , zdenom, zdenom2 REAL(wp) :: zfact   , zfood, zfoodlim, zbeta REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn zgrazing(ji,jj,jk) = zgraztotc !    Various remineralization and excretion terms !    -------------------------------------------- ! Microzooplankton efficiency. ! We adopt a formulation proposed by Mitra et al. (2007) ! The gross growth efficiency is controled by the most limiting nutrient. ! Growth is also further decreased when the food quality is poor. This is currently ! hard coded : it can be decreased by up to 50% (zepsherq) ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and ! Fulton, 2012) ! ----------------------------------------------------------------------------- zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) zbeta     = MAX(0., (epsher - epshermin) ) zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) zepsherv  = zepsherf * zepshert zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) zepsherv  = zepsherf * zepshert * zepsherq zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )
• ## NEMO/branches/2020/r12581_ticket2418/src/TOP/PISCES/SED/sedchem.F90

 r12377 saltprac(:) = salt(:) * 35.0 / 35.16504 ELSE saltprac(:) = temp(:) saltprac(:) = salt(:) ENDIF
• ## NEMO/branches/2020/r12581_ticket2418/src/TOP/PISCES/SED/sedinorg.F90

 r10225 zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk) END DO zsolcpsi = MAX( zsolcpsi, rtrn ) zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 ) zsieq(ji) = MAX( rtrn, sieqs(ji) )
• ## NEMO/branches/2020/r12581_ticket2418/tests/BENCH/MY_SRC/usrdef_hgr.F90

 r9762 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 4.0, NEMO Consortium (2016) ! ! Position coordinates (in grid points) !                          ========== DO jj = 1, jpj DO ji = 1, jpi zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp ) zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp !                          ========== DO_2D_11_11 zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp ) zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp plamt(ji,jj) = zti plamu(ji,jj) = zui plamv(ji,jj) = zti plamf(ji,jj) = zui pphit(ji,jj) = ztj pphiv(ji,jj) = zvj pphiu(ji,jj) = ztj pphif(ji,jj) = zvj plamt(ji,jj) = zti plamu(ji,jj) = zui plamv(ji,jj) = zti plamf(ji,jj) = zui pphit(ji,jj) = ztj pphiv(ji,jj) = zvj pphiu(ji,jj) = ztj pphif(ji,jj) = zvj END DO END DO END_2D ! ! Horizontal scale factors (in meters)
• ## NEMO/branches/2020/r12581_ticket2418/tests/BENCH/MY_SRC/usrdef_istate.F90

 r11536 PUBLIC   usr_def_istate   ! called by istate.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 4.0 , NEMO Consortium (2016) ! ! define unique value on each point. z2d ranging from 0.05 to -0.05 DO jj = 1, jpj DO ji = 1, jpi z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + mjg(jj) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) ENDDO ENDDO DO_2D_11_11 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + (mjg(jj)-1) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) END_2D ! ! sea level: pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:)           ! 30 to 31 +/- 0.05 psu ! velocities: pu(:,:,jk) = z2d(:,:) * 0.1_wp                                   ! +/- 0.005  m/s pv(:,:,jk) = z2d(:,:) * 0.01_wp                                  ! +/- 0.0005 m/s pu(:,:,jk) = z2d(:,:) *  0.1_wp * umask(:,:,jk)                  ! +/- 0.005  m/s pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk)                  ! +/- 0.0005 m/s ENDDO !
• ## NEMO/branches/2020/r12581_ticket2418/tests/BENCH/MY_SRC/usrdef_sbc.F90

 r12377 PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 4.0 , NEMO Consortium (2016) ! ! define unique value on each point. z2d ranging from 0.05 to -0.05 DO jj = 1, jpj DO ji = 1, jpi z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) ENDDO ENDDO DO_2D_11_11 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) END_2D utau_ice(:,:) = 0.1_wp +  z2d(:,:) vtau_ice(:,:) = 0.1_wp +  z2d(:,:)

• ## NEMO/branches/2020/r12581_ticket2418/tests/CANAL/MY_SRC/usrdef_hgr.F90

 r10074 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) #endif DO jj = 1, jpj DO ji = 1, jpi zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * zti plamu(ji,jj) = zlam0 + rn_dx * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * ztj pphiv(ji,jj) = zphi0 + rn_dy * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * zti plamu(ji,jj) = zlam0 + rn_dx * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * ztj pphiv(ji,jj) = zphi0 + rn_dy * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END_2D ! ! Horizontal scale factors (in meters)

• ## NEMO/branches/2020/r12581_ticket2418/tests/CANAL/MY_SRC/usrdef_sbc.F90

 r12377 CONTAINS SUBROUTINE usrdef_sbc_oce( kt, Kmm, Kbb ) SUBROUTINE usrdef_sbc_oce( kt, Kbb ) !!--------------------------------------------------------------------- !!                    ***  ROUTINE usr_def_sbc  *** !!---------------------------------------------------------------------- INTEGER, INTENT(in) ::   kt        ! ocean time step INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time index INTEGER, INTENT(in) ::   Kbb       ! ocean time index INTEGER  ::   ji, jj               ! dummy loop indices REAL(wp) :: zrhoair = 1.22     ! approximate air density [Kg/m3] WHERE( ABS(gphit) <= rn_windszy/2. ) zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kmm) zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kbb) ELSEWHERE zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kmm) zwndrel(:,:) =        - rn_uofac * uu(:,:,1,Kbb) END WHERE utau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kmm) zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kbb) vtau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:)
• ## NEMO/branches/2020/r12581_ticket2418/tests/CANAL/MY_SRC/usrdef_zgr.F90

 r12377 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) ! k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere ! k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere

 r10513 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy DO jj = 1, jpj DO ji = 1, jpi zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END_2D ! constant scale factors

 r10515 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) #endif DO jj = 1, jpj DO ji = 1, jpi zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END_2D ! Horizontal scale factors (in meters)

 r12377 !!   usr_def_hgr   : initialize the horizontal mesh !!---------------------------------------------------------------------- USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain USE dom_oce  , ONLY: nimpp , njmpp, Agrif_Root            ! i- & j-indices of the local domain USE par_oce        ! ocean space and time domain USE phycst         ! physical constants
• ## NEMO/branches/2020/r12581_ticket2418/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90

 r10516 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) #endif DO jj = 1, jpj DO ji = 1, jpi zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END_2D ! Horizontal scale factors (in meters)

• ## NEMO/branches/2020/r12581_ticket2418/tests/ISOMIP/MY_SRC/usrdef_zgr.F90

 r12377 PUBLIC   usr_def_zgr   ! called by domzgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) pe3vw(:,:,jk) = pe3w_1d (jk) END DO DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points DO ji = 1, jpi ik = k_top(ji,jj) IF ( ik > 2 ) THEN ! pdeptw at the interface pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) ! e3t in both side of the interface pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) ! pdept in both side of the interface (from previous e3t) pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp ! pe3w on both side of the interface pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) ! e3t into the ice shelf pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) END IF END DO END DO DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points DO ji = 1, jpi ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) ! top scale factors and depth at T- and W-points DO_2D_11_11 ik = k_top(ji,jj) IF ( ik > 2 ) THEN ! pdeptw at the interface pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) ! e3t in both side of the interface pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! ! pdept in both side of the interface (from previous e3t) pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) END DO END DO pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp ! pe3w on both side of the interface pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) ! e3t into the ice shelf pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) END IF END_2D ! bottom scale factors and depth at T- and W-points DO_2D_11_11 ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) END_2D !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points pe3u (:,:,:) = pe3t(:,:,:) pe3uw(:,:,:) = pe3w(:,:,:) DO jk = 1, jpk                      ! Computed as the minimum of neighbooring scale factors DO jj = 1, jpjm1 DO ji = 1, jpi pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) pe3f (ji,jj,jk) = pe3v(ji,jj,jk) END DO END DO END DO DO_3D_00_00( 1, jpk ) !                                   ! Computed as the minimum of neighbooring scale factors pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) pe3f (ji,jj,jk) = pe3v(ji,jj,jk) END_3D CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp )
• ## NEMO/branches/2020/r12581_ticket2418/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90

 r10074 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !                       !==  grid point position  ==!   (in kilometers) zfact = rn_dx * 1.e-3         ! conversion in km DO jj = 1, jpj DO ji = 1, jpi             ! longitude plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  ) plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) !                       ! latitude pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) pphiu(ji,jj) = pphit(ji,jj) pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 !                       ! longitude plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  ) plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) !                       ! latitude pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) pphiu(ji,jj) = pphit(ji,jj) pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) pphif(ji,jj) = pphiv(ji,jj) END_2D ! !                       !==  Horizontal scale factors  ==!   (in meters)
• ## NEMO/branches/2020/r12581_ticket2418/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90

 r10074 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !                       !==  grid point position  ==!   (in kilometers) zfact = rn_dx * 1.e-3         ! conversion in km DO jj = 1, jpj DO ji = 1, jpi             ! longitude plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  ) plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) !                       ! latitude pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) pphiu(ji,jj) = pphit(ji,jj) pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 !                       ! longitude plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  ) plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) !                       ! latitude pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) pphiu(ji,jj) = pphit(ji,jj) pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) pphif(ji,jj) = pphiv(ji,jj) END_2D ! !                       !==  Horizontal scale factors  ==!   (in meters)
• ## NEMO/branches/2020/r12581_ticket2418/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

 r12377 PUBLIC   usr_def_zgr   ! called by domzgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) pe3vw(:,:,jk) = pe3w_1d (jk) END DO DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points DO ji = 1, jpi ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) END DO END DO DO_2D_11_11 ik = k_bot(ji,jj) pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) ! pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) END_2D !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points !                                   ! usually Computed as the minimum of neighbooring scale factors

• ## NEMO/branches/2020/r12581_ticket2418/tests/VORTEX/MY_SRC/usrdef_hgr.F90

 r10074 PUBLIC   usr_def_hgr   ! called by domhgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) #endif DO jj = 1, jpj DO ji = 1, jpi zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END DO END DO DO_2D_11_11 zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui plamv(ji,jj) = plamt(ji,jj) plamf(ji,jj) = plamu(ji,jj) pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj pphiu(ji,jj) = pphit(ji,jj) pphif(ji,jj) = pphiv(ji,jj) END_2D ! ! Horizontal scale factors (in meters)