Changeset 13540 for NEMO/branches/2020/r12377_ticket2386/tests
- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 3 deleted
- 122 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/EXPREF/namelist_cfg_orca025_like
r12511 r13540 15 15 &namusr_def ! User defined : BENCH configuration: Flat bottom, beta-plane 16 16 !----------------------------------------------------------------------- 17 nn_isize = 144 2! number of point in i-direction of global(local) domain if >0 (<0)18 nn_jsize = 120 7 !! 1050! number of point in j-direction of global(local) domain if >0 (<0)17 nn_isize = 1440 ! number of point in i-direction of global(local) domain if >0 (<0) 18 nn_jsize = 1206 !! 1049 ! number of point in j-direction of global(local) domain if >0 (<0) 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 4 ! periodicity … … 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / … … 50 49 !----------------------------------------------------------------------- 51 50 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 51 nn_ice = 2 ! =0 no ice boundary condition 52 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 53 ! ! =2 or 3 for SI3 and CICE, respectively 52 54 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) 53 55 / … … 75 77 !! !! 76 78 !! namdrg top/bottom drag coefficient (default: NO selection) 77 !! namdrg_top top friction (ln_ OFF =F & ln_isfcav=T)78 !! namdrg_bot bottom friction (ln_ OFF =F)79 !! namdrg_top top friction (ln_drg_OFF =F & ln_isfcav=T) 80 !! namdrg_bot bottom friction (ln_drg_OFF =F) 79 81 !! nambbc bottom temperature boundary condition (default: OFF) 80 82 !! nambbl bottom boundary layer scheme (default: OFF) -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/EXPREF/namelist_cfg_orca12_like
r12511 r13540 15 15 &namusr_def ! User defined : BENCH configuration: Flat bottom, beta-plane 16 16 !----------------------------------------------------------------------- 17 nn_isize = 432 2! number of point in i-direction of global(local) domain if >0 (<0)18 nn_jsize = 314 7! number of point in j-direction of global(local) domain if >0 (<0)17 nn_isize = 4320 ! number of point in i-direction of global(local) domain if >0 (<0) 18 nn_jsize = 3146 ! number of point in j-direction of global(local) domain if >0 (<0) 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 4 ! periodicity … … 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / … … 50 49 !----------------------------------------------------------------------- 51 50 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 51 nn_ice = 2 ! =0 no ice boundary condition 52 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 53 ! ! =2 or 3 for SI3 and CICE, respectively 52 54 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) 53 55 / … … 75 77 !! !! 76 78 !! namdrg top/bottom drag coefficient (default: NO selection) 77 !! namdrg_top top friction (ln_ OFF =F & ln_isfcav=T)78 !! namdrg_bot bottom friction (ln_ OFF =F)79 !! namdrg_top top friction (ln_drg_OFF =F & ln_isfcav=T) 80 !! namdrg_bot bottom friction (ln_drg_OFF =F) 79 81 !! nambbc bottom temperature boundary condition (default: OFF) 80 82 !! nambbl bottom boundary layer scheme (default: OFF) -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/EXPREF/namelist_cfg_orca1_like
r12511 r13540 15 15 &namusr_def ! User defined : BENCH configuration: Flat bottom, beta-plane 16 16 !----------------------------------------------------------------------- 17 nn_isize = 36 2! number of point in i-direction of global(local) domain if >0 (<0)18 nn_jsize = 33 2! number of point in j-direction of global(local) domain if >0 (<0)17 nn_isize = 360 ! number of point in i-direction of global(local) domain if >0 (<0) 18 nn_jsize = 331 ! number of point in j-direction of global(local) domain if >0 (<0) 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 6 ! periodicity … … 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / … … 50 49 !----------------------------------------------------------------------- 51 50 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 51 nn_ice = 2 ! =0 no ice boundary condition 52 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 53 ! ! =2 or 3 for SI3 and CICE, respectively 52 54 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) 53 55 / … … 75 77 !! !! 76 78 !! namdrg top/bottom drag coefficient (default: NO selection) 77 !! namdrg_top top friction (ln_ OFF =F & ln_isfcav=T)78 !! namdrg_bot bottom friction (ln_ OFF =F)79 !! namdrg_top top friction (ln_drg_OFF =F & ln_isfcav=T) 80 !! namdrg_bot bottom friction (ln_drg_OFF =F) 79 81 !! nambbc bottom temperature boundary condition (default: OFF) 80 82 !! nambbl bottom boundary layer scheme (default: OFF) -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/EXPREF/namelist_pisces_cfg
r10343 r13540 81 81 / 82 82 !----------------------------------------------------------------------- 83 &nampis sbc! parameters for inputs deposition83 &nampisbc ! parameters for inputs deposition 84 84 !----------------------------------------------------------------------- 85 ln_dust = .false. ! boolean for dust input from the atmosphere86 ln_solub = .false. ! boolean for variable solubility of atm. Iron87 ln_river = .false. ! boolean for river input of nutrients88 ln_ndepo = .false. ! boolean for atmospheric deposition of N89 85 ln_ironsed = .false. ! boolean for Fe input from sediments 90 86 ln_ironice = .false. ! boolean for Fe input from sea ice -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/MY_SRC/usrdef_hgr.F90
r9762 r13540 24 24 PUBLIC usr_def_hgr ! called by domhgr.F90 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/OPA 4.0, NEMO Consortium (2016) … … 59 61 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 60 62 ! 61 INTEGER :: ji, jj ! dummy loop indices63 INTEGER :: ji, jj ! dummy loop indices 62 64 REAL(wp) :: zres, zf0 63 REAL(wp) :: zti, z ui, ztj, zvj! local scalars65 REAL(wp) :: zti, ztj ! local scalars 64 66 !!------------------------------------------------------------------------------- 65 67 ! … … 70 72 IF(lwp) WRITE(numout,*) ' given by rn_dx and rn_dy' 71 73 ! 72 !73 74 ! Position coordinates (in grid points) 74 ! ========== 75 DO jj = 1, jpj 76 DO ji = 1, jpi 77 78 zti = REAL( ji - 1 + nimpp - 1, wp ) ; ztj = REAL( jj - 1 + njmpp - 1, wp ) 79 zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ; zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp 75 ! ========== 76 DO_2D( 1, 1, 1, 1 ) 77 78 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 79 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 80 81 plamt(ji,jj) = zti 82 plamu(ji,jj) = zti + 0.5_wp 83 plamv(ji,jj) = zti 84 plamf(ji,jj) = zti + 0.5_wp 85 86 pphit(ji,jj) = ztj 87 pphiu(ji,jj) = ztj 88 pphiv(ji,jj) = ztj + 0.5_wp 89 pphif(ji,jj) = ztj + 0.5_wp 80 90 81 plamt(ji,jj) = zti 82 plamu(ji,jj) = zui 83 plamv(ji,jj) = zti 84 plamf(ji,jj) = zui 85 86 pphit(ji,jj) = ztj 87 pphiv(ji,jj) = zvj 88 pphiu(ji,jj) = ztj 89 pphif(ji,jj) = zvj 90 91 END DO 92 END DO 91 END_2D 93 92 ! 94 93 ! Horizontal scale factors (in meters) … … 109 108 kff = 1 ! indicate not to compute Coriolis parameter afterward 110 109 ! 111 zf0 110 zf0 = 2._wp * omega * SIN( rad * 45 ) ! constant coriolis factor corresponding to 45°N 112 111 pff_f(:,:) = zf0 113 112 pff_t(:,:) = zf0 -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/MY_SRC/usrdef_istate.F90
r11536 r13540 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OPA 4.0 , NEMO Consortium (2016) … … 55 57 REAL(wp) :: zfact 56 58 INTEGER :: ji, jj, jk 59 INTEGER :: igloi, igloj ! to be removed in the future, see comment bellow 57 60 !!---------------------------------------------------------------------- 58 61 ! … … 61 64 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 62 65 ! 63 ! define unique value on each point. z2d ranging from 0.05 to -0.05 64 DO jj = 1, jpj 65 DO ji = 1, jpi 66 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + mjg(jj) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 67 ENDDO 68 ENDDO 66 ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 67 ! 68 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 69 ! we must define z2d as bellow. 70 ! Once we decide to forget trunk compatibility, we must simply define z2d as: 71 !!$ DO_2D( 0, 0, 0, 0 ) 72 !!$ z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 73 !!$ END_2D 74 igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 75 igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 76 DO_2D( 0, 0, 0, 0 ) 77 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 78 END_2D 69 79 ! 70 80 ! sea level: 71 81 pssh(:,:) = z2d(:,:) ! +/- 0.05 m 72 82 ! 73 DO jk = 1, jpk83 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 74 84 zfact = REAL(jk-1,wp) / REAL(jpk-1,wp) ! 0 to 1 to add a basic stratification 75 85 ! temperature choosen to lead to ~50% ice at the beginning if rn_thres_sst = 0.5 … … 78 88 pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:) ! 30 to 31 +/- 0.05 psu 79 89 ! velocities: 80 pu(:,:,jk) = z2d(:,:) * 0.1_wp ! +/- 0.005 m/s 81 pv(:,:,jk) = z2d(:,:) * 0.01_wp ! +/- 0.0005 m/s 82 ENDDO 90 pu(:,:,jk) = z2d(:,:) * 0.1_wp * umask(:,:,jk) ! +/- 0.005 m/s 91 pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk) ! +/- 0.0005 m/s 92 END_3D 93 pts(:,:,jpk,:) = 0._wp 94 pu( :,:,jpk ) = 0._wp 95 pv( :,:,jpk ) = 0._wp 83 96 ! 84 97 CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/MY_SRC/usrdef_nam.F90
r12377 r13540 55 55 ! !!* nammpp namelist *!! 56 56 INTEGER :: jpni, jpnj 57 LOGICAL :: ln_nnogather 57 LOGICAL :: ln_nnogather, ln_listonly 58 58 !! 59 59 NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, nn_perio 60 NAMELIST/nammpp/ jpni, jpnj, ln_nnogather60 NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 61 61 !!---------------------------------------------------------------------- 62 62 ! … … 77 77 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 78 78 79 kpi = ( -nn_isize - 2*nn_hls ) * jpni + 2*nn_hls80 kpj = ( -nn_jsize - 2*nn_hls ) * jpnj + 2*nn_hls79 kpi = -nn_isize * jpni 80 kpj = -nn_jsize * jpnj 81 81 ELSE 82 82 kpi = nn_isize -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/MY_SRC/usrdef_sbc.F90
r12377 r13540 34 34 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo 35 35 36 !! * Substitutions 37 # include "do_loop_substitute.h90" 36 38 !!---------------------------------------------------------------------- 37 39 !! NEMO/OPA 4.0 , NEMO Consortium (2016) … … 97 99 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 98 100 INTEGER :: ji, jj 101 INTEGER :: igloi, igloj ! to be removed in the future, see comment bellow 99 102 !!--------------------------------------------------------------------- 100 103 #if defined key_si3 … … 102 105 ! 103 106 ! define unique value on each point. z2d ranging from 0.05 to -0.05 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 107 ENDDO 108 ENDDO 109 utau_ice(:,:) = 0.1_wp + z2d(:,:) 110 vtau_ice(:,:) = 0.1_wp + z2d(:,:) 107 ! 108 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 109 ! we must define z2d as bellow. 110 ! Once we decide to forget trunk compatibility, we must simply define z2d as: 111 !!$ DO_2D( 0, 0, 0, 0 ) 112 !!$ z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 113 !!$ END_2D 114 igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 115 igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 116 DO_2D( 0, 0, 0, 0 ) 117 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 118 END_2D 119 utau_ice(:,:) = 0.1_wp + z2d(:,:) 120 vtau_ice(:,:) = 0.1_wp + z2d(:,:) 111 121 112 122 CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) … … 127 137 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 128 138 !! 129 REAL(wp) :: zfr1, zfr2 ! local variables130 139 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 131 140 !!--------------------------------------------------------------------- … … 162 171 qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 163 172 164 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 165 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 166 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 167 ! 168 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 169 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 170 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 171 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 172 ELSEWHERE ! zero when hs>0 173 qtr_ice_top(:,:,:) = 0._wp 174 END WHERE 173 ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 174 qtr_ice_top(:,:,:) = 0._wp 175 175 176 #endif 176 177 -
NEMO/branches/2020/r12377_ticket2386/tests/BENCH/MY_SRC/usrdef_zgr.F90
r12377 r13540 192 192 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 193 193 ! 194 IF( jperio == 3 .OR. jperio ==4 ) THEN ! add a small island in the upper corners to avoid model instabilities... 195 z2d(mi0( 1):mi1( 3),mj0(jpjglo-2):mj1(jpjglo)) = 0. 196 z2d(mi0(jpiglo-2):mi1(jpiglo),mj0(jpjglo-2):mj1(jpjglo)) = 0. 197 ENDIF 194 ! 195 ! BENCH should work without these 2 small islands on the 2 poles of the folding... 196 ! -> Comment out these lines if instabilities are too large... 197 ! 198 199 !!$ IF( jperio == 3 .OR. jperio == 4 ) THEN ! add a small island in the upper corners to avoid model instabilities... 200 !!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 201 !!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 202 !!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 203 !!$ ENDIF 204 !!$ ! 205 !!$ IF( jperio == 5 .OR. jperio == 6 ) THEN ! add a small island in the upper corners to avoid model instabilities... 206 !!$ z2d(mi0( nn_hls):mi1( nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 207 !!$ z2d(mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 208 !!$ z2d(mi0(jpiglo/2 ):mi1(jpiglo/2 +1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 209 !!$ ENDIF 210 198 211 ! 199 212 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/EXPREF/file_def_nemo-oce.xml
r9572 r13540 15 15 <field field_ref="soce" /> 16 16 <field field_ref="ssh" /> 17 <field field_ref="s algrad" />18 <field field_ref=" ke_zint" />17 <field field_ref="socegrad" /> 18 <field field_ref="eken_int" /> 19 19 <field field_ref="relvor" /> 20 20 <field field_ref="potvor" /> -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/EXPREF/namelist_cfg
r12511 r13540 20 20 &namusr_def ! User defined : CANAL configuration: Flat bottom, beta-plane 21 21 !----------------------------------------------------------------------- 22 rn_domszx = 3600. ! x horizontal size [km]23 rn_domszy = 1 800. ! y horizontal size [km]24 rn_domszz = 5000. ! z vertical size [m]25 rn_dx = 30. ! x horizontal resolution [km]26 rn_dy = 30. ! y horizontal resolution [km]27 rn_dz = 500. ! z vertical resolution [m]22 rn_domszx = 2000. ! x horizontal size [km] 23 rn_domszy = 1000. ! y horizontal size [km] 24 rn_domszz = 1000. ! z vertical size [m] 25 rn_dx = 10. ! x horizontal resolution [km] 26 rn_dy = 10. ! y horizontal resolution [km] 27 rn_dz = 1000. ! z vertical resolution [m] 28 28 rn_0xratio = 0.5 ! x-domain ratio of the 0 29 29 rn_0yratio = 0.5 ! y-domain ratio of the 0 … … 31 31 rn_ppgphi0 = 38.5 ! Reference latitude [degrees] 32 32 rn_u10 = 0. ! 10m wind speed [m/s] 33 rn_windszx = 4000.! longitudinal wind extension [km]34 rn_windszy = 4000.! latitudinal wind extension [km]35 rn_uofac = 0.! Uoce multiplicative factor (0.:absolute or 1.:relative winds)33 rn_windszx = 90. ! longitudinal wind extension [km] 34 rn_windszy = 90. ! latitudinal wind extension [km] 35 !!clem rn_uofac = 0. ! Uoce multiplicative factor (0.:absolute or 1.:relative winds) 36 36 rn_vtxmax = 1. ! initial vortex max current [m/s] 37 37 rn_uzonal = 1. ! initial zonal current [m/s] 38 rn_ujetszx = 4000. 39 rn_ujetszy = 400 0. ! latitudinal jet extension [km]38 rn_ujetszx = 4000. ! longitudinal jet extension [km] 39 rn_ujetszy = 400. ! latitudinal jet extension [km] 40 40 nn_botcase = 0 ! bottom definition (0:flat, 1:bump) 41 nn_initcase = 1 ! initial condition case (0:rest, 1:zonal current, 2:current shear, 3: gaussian zonal current, 42 ! ! 4: geostrophic zonal pulse, 5: vortex) 43 ln_sshnoise = .false. ! add random noise on initial ssh 44 rn_lambda = 50. ! gaussian lambda 41 nn_initcase = 1 ! initial condition case 42 ! ! -1 : stratif at rest 43 ! ! 0 : rest 44 ! ! 1 : zonal current 45 ! ! 2 : current shear 46 ! ! 3 : gaussian zonal current 47 ! ! 4 : geostrophic zonal pulse 48 ! ! 5 : baroclinic vortex 49 ln_sshnoise = .FALSE. ! add random noise on initial ssh 50 rn_lambda = 50. ! gaussian lambda 51 nn_perio = 1 45 52 / 46 53 !----------------------------------------------------------------------- … … 59 66 !----------------------------------------------------------------------- 60 67 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 61 rn_Dt = 1440. ! time step for the dynamics (and tracer if nn_acc=0) 62 rn_atfp = 0.05 ! asselin time filter parameter 68 rn_Dt = 1200. ! time step for the dynamics (and tracer if nn_acc=0) 69 rn_atfp = 0.0 ! asselin time filter parameter 70 / 71 !----------------------------------------------------------------------- 72 &namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg) 73 !----------------------------------------------------------------------- 74 ln_write_cfg = .false. ! (=T) create the domain configuration file 75 cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 63 76 / 64 77 !!====================================================================== … … 108 121 !! !! 109 122 !! namdrg top/bottom drag coefficient (default: NO selection) 110 !! namdrg_top top friction (ln_ OFF =F & ln_isfcav=T)111 !! namdrg_bot bottom friction (ln_ OFF =F)123 !! namdrg_top top friction (ln_drg_OFF =F & ln_isfcav=T) 124 !! namdrg_bot bottom friction (ln_drg_OFF =F) 112 125 !! nambbc bottom temperature boundary condition (default: OFF) 113 126 !! nambbl bottom boundary layer scheme (default: OFF) … … 117 130 &namdrg ! top/bottom drag coefficient (default: NO selection) 118 131 !----------------------------------------------------------------------- 119 ln_ OFF = .true. ! free-slip : Cd = 0132 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 120 133 / 121 134 !!====================================================================== … … 134 147 !----------------------------------------------------------------------- 135 148 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 136 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS149 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 137 150 rn_a0 = 0.28 ! thermal expension coefficient (for simplified equation of state) 138 151 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) … … 148 161 ln_traadv_OFF = .false. ! No tracer advection 149 162 ln_traadv_cen = .false. ! 2nd order centered scheme 150 nn_cen_h = 4! =2/4, horizontal 2nd order CEN / 4th order CEN151 nn_cen_v = 4! =2/4, vertical 2nd order CEN / 4th order COMPACT163 nn_cen_h = 2 ! =2/4, horizontal 2nd order CEN / 4th order CEN 164 nn_cen_v = 2 ! =2/4, vertical 2nd order CEN / 4th order COMPACT 152 165 ln_traadv_fct = .false. ! FCT scheme 153 nn_fct_h = 2! =2/4, horizontal 2nd / 4th order166 nn_fct_h = 4 ! =2/4, horizontal 2nd / 4th order 154 167 nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order 155 168 ln_traadv_mus = .false. ! MUSCL scheme … … 162 175 &namtra_ldf ! lateral diffusion scheme for tracers (default: NO selection) 163 176 !----------------------------------------------------------------------- 164 ln_traldf_OFF = .true. ! No explicit diffusion 177 ! ! Operator type: 178 ln_traldf_OFF = .true. ! No explicit diffusion 179 ln_traldf_lap = .false. ! laplacian operator 180 ln_traldf_blp = .false. ! bilaplacian operator 181 ! 182 ! ! Direction of action: 183 ln_traldf_lev = .false. ! iso-level 184 ln_traldf_hor = .true. ! horizontal (geopotential) 185 ln_traldf_iso = .false. ! iso-neutral (standard operator) 186 ln_traldf_triad = .false. ! iso-neutral (triad operator) 187 ! 188 ! ! iso-neutral options: 189 ln_traldf_msc = .false. ! Method of Stabilizing Correction (both operators) 190 rn_slpmax = 0.01 ! slope limit (both operators) 191 ln_triad_iso = .false. ! pure horizontal mixing in ML (triad only) 192 rn_sw_triad = 1 ! =1 switching triad ; =0 all 4 triads used (triad only) 193 ln_botmix_triad = .false. ! lateral mixing on bottom (triad only) 194 ! 195 ! ! Coefficients: 196 nn_aht_ijk_t = 31 ! space/time variation of eddy coefficient: 197 ! ! =-20 (=-30) read in eddy_diffusivity_2D.nc (..._3D.nc) file 198 ! ! = 0 constant 199 ! ! = 10 F(k) =ldf_c1d 200 ! ! = 20 F(i,j) =ldf_c2d 201 ! ! = 21 F(i,j,t) =Treguier et al. JPO 1997 formulation 202 ! ! = 30 F(i,j,k) =ldf_c2d * ldf_c1d 203 ! ! = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 204 ! ! time invariant coefficients: aht0 = 1/2 Ud*Ld (lap case) 205 ! ! or = 1/12 Ud*Ld^3 (blp case) 206 rn_Ud = 0.01 ! lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 207 rn_Ld = 200.e+3 ! lateral diffusive length [m] (nn_aht_ijk_t= 0, 10) 165 208 / 166 209 !!====================================================================== … … 183 226 nn_dynkeg = 0 ! scheme for grad(KE): =0 C2 ; =1 Hollingsworth correction 184 227 ln_dynadv_cen2 = .false. ! flux form - 2nd order centered scheme 185 ln_dynadv_ubs = .true. ! flux form - 3rd order UBS scheme228 ln_dynadv_ubs = .true. ! flux form - 3rd order UBS scheme 186 229 / 187 230 !----------------------------------------------------------------------- 188 231 &namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection) 189 232 !----------------------------------------------------------------------- 190 ln_dynvor_ene = . true. ! energy conserving scheme191 ln_dynvor_ens = .false. ! enstrophy conserving scheme192 ln_dynvor_mix = .false. ! mixed scheme233 ln_dynvor_ene = .false. ! energy conserving scheme 234 ln_dynvor_ens = .false. ! enstrophy conserving scheme 235 ln_dynvor_mix = .false. ! mixed scheme 193 236 ln_dynvor_een = .false. ! energy & enstrophy scheme 237 ln_dynvor_enT = .false. ! energy conserving scheme (T-point) 238 ln_dynvor_eeT = .true. ! energy conserving scheme (een using e3t) 194 239 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 195 240 / … … 210 255 ! ! = 1 Boxcar over nn_e sub-steps 211 256 ! ! = 2 Boxcar over 2*nn_e " " 212 ln_bt_auto = . false. ! Number of sub-step defined from:257 ln_bt_auto = .true. ! Number of sub-step defined from: 213 258 nn_e = 24 ! =F : the number of sub-step in rn_Dt seconds 214 259 / … … 222 267 ! ! Direction of action : 223 268 ln_dynldf_lev = .false. ! iso-level 224 ln_dynldf_hor = . true. ! horizontal (geopotential)269 ln_dynldf_hor = .false. ! horizontal (geopotential) 225 270 ln_dynldf_iso = .false. ! iso-neutral 226 271 ! ! Coefficient 227 nn_ahm_ijk_t = 20! space/time variation of eddy coef272 nn_ahm_ijk_t = 31 ! space/time variation of eddy coef 228 273 ! ! =-30 read in eddy_viscosity_3D.nc file 229 274 ! ! =-20 read in eddy_viscosity_2D.nc file … … 275 320 !! namdiu Cool skin and warm layer models (default: OFF) 276 321 !! namdiu Cool skin and warm layer models (default: OFF) 322 <<<<<<< .working 277 323 !! namflo float parameters (default: OFF) 278 324 !! nam_diadct transports through some sections (default: OFF) 325 ||||||| .merge-left.r13465 326 !! namflo float parameters (default: OFF) 327 !! nam_diaharm Harmonic analysis of tidal constituents (default: OFF) 328 !! nam_diadct transports through some sections (default: OFF) 329 ======= 330 !! namflo float parameters ("key_float") 331 !! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm") 332 !! namdct transports through some sections ("key_diadct") 333 !! nam_diatmb Top Middle Bottom Output (default: OFF) 334 >>>>>>> .merge-right.r13470 279 335 !! nam_dia25h 25h Mean Output (default: OFF) 280 336 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") … … 285 341 !----------------------------------------------------------------------- 286 342 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE 287 ln_dyn_trd = .true. ! (T) 3D momentum trend output343 ln_dyn_trd = .true. ! (T) 3D momentum trend output 288 344 ln_dyn_mxl = .false. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 289 345 ln_vor_trd = .false. ! (T) 2D barotropic vorticity trends (not coded yet) … … 312 368 &nammpp ! Massively Parallel Processing ("key_mpp_mpi") 313 369 !----------------------------------------------------------------------- 370 !! jpni = 8 ! jpni number of processors following i (set automatically if < 1) 371 !! jpnj = 1 ! jpnj number of processors following j (set automatically if < 1) 314 372 / 315 373 !----------------------------------------------------------------------- 316 374 &namctl ! Control prints (default: OFF) 317 375 !----------------------------------------------------------------------- 376 ln_timing = .true. ! timing by routine write out in timing.output file 377 !! ln_diacfl = .true. ! CFL diagnostics write out in cfl_diagnostics.ascii 318 378 / 319 379 !----------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/domvvl.F90
r12511 r13540 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 11 12 !!---------------------------------------------------------------------- 12 13 13 !!----------------------------------------------------------------------14 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness15 !! dom_vvl_sf_nxt : Compute next vertical scale factors16 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid17 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another18 !! dom_vvl_rst : read/write restart file19 !! dom_vvl_ctl : Check the vvl options20 !!----------------------------------------------------------------------21 14 USE oce ! ocean dynamics and tracers 22 15 USE phycst ! physical constant … … 36 29 PRIVATE 37 30 38 PUBLIC dom_vvl_init ! called by domain.F9039 PUBLIC dom_vvl_sf_nxt ! called by step.F9040 PUBLIC dom_vvl_sf_update ! called by step.F9041 PUBLIC dom_vvl_interpol ! called by dynnxt.F9042 43 31 ! !!* Namelist nam_vvl 44 32 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate … … 62 50 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 63 51 52 #if defined key_qco 53 !!---------------------------------------------------------------------- 54 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 55 !!---------------------------------------------------------------------- 56 #else 57 !!---------------------------------------------------------------------- 58 !! Default key Old management of time varying vertical coordinate 59 !!---------------------------------------------------------------------- 60 61 !!---------------------------------------------------------------------- 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness 63 !! dom_vvl_sf_nxt : Compute next vertical scale factors 64 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 65 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 66 !! dom_vvl_rst : read/write restart file 67 !! dom_vvl_ctl : Check the vvl options 68 !!---------------------------------------------------------------------- 69 70 PUBLIC dom_vvl_init ! called by domain.F90 71 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 72 PUBLIC dom_vvl_sf_nxt ! called by step.F90 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 76 !! * Substitutions 77 # include "do_loop_substitute.h90" 64 78 !!---------------------------------------------------------------------- 65 79 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 116 130 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 117 131 ! 132 IF(lwp) WRITE(numout,*) 133 IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 134 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 135 ! 136 CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 137 ! 138 ! ! Allocate module arrays 139 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 140 ! 141 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 142 CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' ) 143 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 144 ! 145 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 146 ! 147 END SUBROUTINE dom_vvl_init 148 149 150 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 151 !!---------------------------------------------------------------------- 152 !! *** ROUTINE dom_vvl_init *** 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 155 !! depths and water column heights 156 !! 157 !! ** Method : - interpolate scale factors 158 !! 159 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 160 !! - Regrid: e3(u/v)_n 161 !! e3(u/v)_b 162 !! e3w_n 163 !! e3(u/v)w_b 164 !! e3(u/v)w_n 165 !! gdept_n, gdepw_n and gde3w_n 166 !! - h(t/u/v)_0 167 !! - frq_rst_e3t and frq_rst_hdv 168 !! 169 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 170 !!---------------------------------------------------------------------- 171 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 172 !!---------------------------------------------------------------------- 118 173 INTEGER :: ji, jj, jk 119 174 INTEGER :: ii0, ii1, ij0, ij1 120 175 REAL(wp):: zcoef 121 176 !!---------------------------------------------------------------------- 122 !123 IF(lwp) WRITE(numout,*)124 IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'125 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'126 !127 CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)128 !129 ! ! Allocate module arrays130 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )131 !132 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf133 CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )134 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all135 177 ! 136 178 ! !== Set of all other vertical scale factors ==! (now and before) … … 160 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 161 203 gdepw(:,:,1,Kbb) = 0.0_wp 162 DO jk = 2, jpk ! vertical sum 163 DO jj = 1,jpj 164 DO ji = 1,jpi 165 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 166 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 167 ! ! 0.5 where jk = mikt 204 DO_3D( 1, 1, 1, 1, 2, jpk ) 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 207 ! ! 0.5 where jk = mikt 168 208 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 169 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 170 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 171 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 172 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 173 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 174 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 175 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 176 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 177 END DO 178 END DO 179 END DO 209 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 210 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 211 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 212 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 213 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 214 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 215 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 216 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 217 END_3D 180 218 ! 181 219 ! !== thickness of the water column !! (ocean portion only) … … 212 250 ENDIF 213 251 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 214 DO jj = 1, jpj 215 DO ji = 1, jpi 252 DO_2D( 1, 1, 1, 1 ) 216 253 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 217 IF( ABS(gphit(ji,jj)) >= 6.) THEN 218 ! values outside the equatorial band and transition zone (ztilde) 219 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 220 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 221 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 222 ! values inside the equatorial band (ztilde as zstar) 223 frq_rst_e3t(ji,jj) = 0.0_wp 224 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 225 ELSE ! transition band (2.5 to 6 degrees N/S) 226 ! ! (linearly transition from z-tilde to z-star) 227 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 228 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 229 & * 180._wp / 3.5_wp ) ) 230 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 231 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 232 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 233 & * 180._wp / 3.5_wp ) ) 234 ENDIF 235 END DO 236 END DO 254 IF( ABS(gphit(ji,jj)) >= 6.) THEN 255 ! values outside the equatorial band and transition zone (ztilde) 256 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 257 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 258 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 259 ! values inside the equatorial band (ztilde as zstar) 260 frq_rst_e3t(ji,jj) = 0.0_wp 261 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 262 ELSE ! transition band (2.5 to 6 degrees N/S) 263 ! ! (linearly transition from z-tilde to z-star) 264 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 265 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 266 & * 180._wp / 3.5_wp ) ) 267 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 268 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 269 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 270 & * 180._wp / 3.5_wp ) ) 271 ENDIF 272 END_2D 237 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 238 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 239 ii0 = 103 ; ii1 = 111240 ij0 = 128 ; ij1 = 135 ;275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 241 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 242 278 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 264 300 ENDIF 265 301 ! 266 END SUBROUTINE dom_vvl_ init302 END SUBROUTINE dom_vvl_zgr 267 303 268 304 … … 298 334 LOGICAL :: ll_do_bclinic ! local logical 299 335 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 300 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 336 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3t 337 LOGICAL , DIMENSION(:,:,:), ALLOCATABLE :: llmsk 301 338 !!---------------------------------------------------------------------- 302 339 ! … … 329 366 END DO 330 367 ! 331 IF( ln_vvl_ztilde .OR. ln_vvl_layer.AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate !332 ! ! ------baroclinic part------ !368 IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 369 ! ! ------baroclinic part------ ! 333 370 ! I - initialization 334 371 ! ================== … … 383 420 zwu(:,:) = 0._wp 384 421 zwv(:,:) = 0._wp 385 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 386 DO jj = 1, jpjm1 387 DO ji = 1, fs_jpim1 ! vector opt. 388 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 389 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 390 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 391 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 392 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 393 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 394 END DO 395 END DO 396 END DO 397 DO jj = 1, jpj ! b - correction for last oceanic u-v points 398 DO ji = 1, jpi 399 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 400 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 401 END DO 402 END DO 403 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 404 DO jj = 2, jpjm1 405 DO ji = fs_2, fs_jpim1 ! vector opt. 406 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 407 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 408 & ) * r1_e1e2t(ji,jj) 409 END DO 410 END DO 411 END DO 422 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 423 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 424 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 425 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 426 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 427 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 428 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 429 END_3D 430 DO_2D( 1, 1, 1, 1 ) 431 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 432 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 433 END_2D 434 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 435 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 436 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 437 & ) * r1_e1e2t(ji,jj) 438 END_3D 412 439 ! ! d - thickness diffusion transport: boundary conditions 413 440 ! (stored for tracer advction and continuity equation) … … 416 443 ! 4 - Time stepping of baroclinic scale factors 417 444 ! --------------------------------------------- 418 ! Leapfrog time stepping419 ! ~~~~~~~~~~~~~~~~~~~~~~420 445 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 421 446 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) … … 423 448 ! Maximum deformation control 424 449 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 425 ze3t(:,:,jpk) = 0._wp 426 DO jk = 1, jpkm1 427 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 428 END DO 429 z_tmax = MAXVAL( ze3t(:,:,:) ) 430 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 431 z_tmin = MINVAL( ze3t(:,:,:) ) 432 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 450 ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 451 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 452 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 453 END_3D 454 ! 455 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 456 llmsk(Nie1: jpi,:,:) = .FALSE. 457 llmsk(:, 1:Njs1,:) = .FALSE. 458 llmsk(:,Nje1: jpj,:) = .FALSE. 459 ! 460 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 461 z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 462 z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 433 463 ! - ML - test: for the moment, stop simulation for too large e3_t variations 434 464 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 435 IF( lk_mpp ) THEN 436 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 437 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 438 ELSE 439 ijk_max = MAXLOC( ze3t(:,:,:) ) 440 ijk_max(1) = ijk_max(1) + nimpp - 1 441 ijk_max(2) = ijk_max(2) + njmpp - 1 442 ijk_min = MINLOC( ze3t(:,:,:) ) 443 ijk_min(1) = ijk_min(1) + nimpp - 1 444 ijk_min(2) = ijk_min(2) + njmpp - 1 445 ENDIF 465 CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 466 CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 446 467 IF (lwp) THEN 447 468 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax … … 452 473 ENDIF 453 474 ENDIF 475 DEALLOCATE( ze3t, llmsk ) 454 476 ! - ML - end test 455 477 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below … … 613 635 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 614 636 ENDIF 615 gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm)616 gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm)617 618 e3t(:,:,:,Kmm) = e3t(:,:,:,Kaa)619 e3u(:,:,:,Kmm) = e3u(:,:,:,Kaa)620 e3v(:,:,:,Kmm) = e3v(:,:,:,Kaa)621 637 622 638 ! Compute all missing vertical scale factor and depths … … 641 657 gdepw(:,:,1,Kmm) = 0.0_wp 642 658 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 643 DO jk = 2, jpk 644 DO jj = 1,jpj 645 DO ji = 1,jpi 646 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 647 ! 1 for jk = mikt 648 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 649 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 650 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 651 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 652 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 653 END DO 654 END DO 655 END DO 659 DO_3D( 1, 1, 1, 1, 2, jpk ) 660 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 661 ! 1 for jk = mikt 662 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 663 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 664 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 665 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 666 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 667 END_3D 656 668 657 669 ! Local depth and Inverse of the local depth of the water … … 700 712 ! 701 713 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 702 DO jk = 1, jpk 703 DO jj = 1, jpjm1 704 DO ji = 1, fs_jpim1 ! vector opt. 705 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 706 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 708 END DO 709 END DO 710 END DO 714 DO_3D( 1, 0, 1, 0, 1, jpk ) 715 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 716 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 717 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 718 END_3D 711 719 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 712 720 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 713 721 ! 714 722 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 715 DO jk = 1, jpk 716 DO jj = 1, jpjm1 717 DO ji = 1, fs_jpim1 ! vector opt. 718 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 719 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 720 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 721 END DO 722 END DO 723 END DO 723 DO_3D( 1, 0, 1, 0, 1, jpk ) 724 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 725 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 726 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 727 END_3D 724 728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 725 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 726 730 ! 727 731 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 728 DO jk = 1, jpk 729 DO jj = 1, jpjm1 730 DO ji = 1, fs_jpim1 ! vector opt. 731 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 732 & * r1_e1e2f(ji,jj) & 733 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 734 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 735 END DO 736 END DO 737 END DO 732 DO_3D( 1, 0, 1, 0, 1, jpk ) 733 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 734 & * r1_e1e2f(ji,jj) & 735 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 736 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 737 END_3D 738 738 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 739 739 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) … … 803 803 IF( ln_rstart ) THEN !* Read the restart file 804 804 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 806 806 ! 807 807 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 810 810 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 811 811 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 812 ! 812 813 ! ! --------- ! 813 814 ! ! all cases ! 814 815 ! ! --------- ! 816 ! 815 817 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 816 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )817 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 818 820 ! needed to restart if land processor not computed 819 821 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 828 830 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 829 831 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 830 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'831 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )832 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 832 834 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 833 835 l_1st_euler = .true. … … 835 837 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 836 838 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 837 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'838 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )839 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 839 841 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 840 842 l_1st_euler = .true. … … 842 844 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 843 845 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 844 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'846 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 845 847 DO jk = 1, jpk 846 848 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 861 863 ! ! ----------------------- ! 862 864 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 863 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios )864 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios )865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 865 867 ELSE ! one at least array is missing 866 868 tilde_e3t_b(:,:,:) = 0.0_wp … … 871 873 ! ! ------------ ! 872 874 IF( id5 > 0 ) THEN ! required array exists 873 CALL iom_get( numror, jpdom_auto glo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios )875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 874 876 ELSE ! array is missing 875 877 hdiv_lf(:,:,:) = 0.0_wp … … 895 897 ssh(:,:,Kbb) = -ssh_ref 896 898 897 DO jj = 1, jpj 898 DO ji = 1, jpi 899 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 900 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 901 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 902 ENDIF 903 ENDDO 904 ENDDO 899 DO_2D( 1, 1, 1, 1 ) 900 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 901 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 902 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 903 ENDIF 904 END_2D 905 905 ENDIF !If test case else 906 906 … … 913 913 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 914 914 915 DO ji = 1, jpi 916 DO jj = 1, jpj 917 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 918 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 919 ENDIF 920 END DO 921 END DO 915 DO_2D( 1, 1, 1, 1 ) 916 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 917 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 918 ENDIF 919 END_2D 922 920 ! 923 921 ELSE 924 922 ! 925 ! usr_def_istate called here only to get sshb, that is needed to initialize e3t(Kbb) and e3t(Kmm) 926 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 927 ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn) 923 ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm) 924 ! 925 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 926 ! 927 ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v 928 928 ! 929 929 DO jk=1,jpk 930 e3t(:,:,jk,K mm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &931 & 932 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t_b!= 0 on land points930 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 931 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 932 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t(:,:,:,Kbb) != 0 on land points 933 933 END DO 934 934 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 935 ssh(:,: ,Kmm) = ssh(:,: ,Kbb)! needed later for gde3w935 ssh(:,:,Kmm) = ssh(:,:,Kbb) ! needed later for gde3w 936 936 ! 937 937 END IF ! end of ll_wd edits … … 1025 1025 ! 1026 1026 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 1027 IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )1028 1027 ! 1029 1028 IF(lwp) THEN ! Print the choice … … 1041 1040 END SUBROUTINE dom_vvl_ctl 1042 1041 1042 #endif 1043 1043 1044 !!====================================================================== 1044 1045 END MODULE domvvl -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/stpctl.F90
r12377 r13540 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE c1d ! 1D vertical configuration 21 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 22 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 23 ! 21 24 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 25 USE in_out_manager ! I/O manager 24 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 27 USE lib_mpp ! distributed memory computing 26 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 27 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 28 28 ! 29 29 USE netcdf ! NetCDF library 30 30 IMPLICIT NONE … … 33 33 PUBLIC stp_ctl ! routine called by step.F90 34 34 35 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus36 LOGICAL :: lsomeoce35 INTEGER :: nrunid ! netcdf file id 36 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 37 37 !!---------------------------------------------------------------------- 38 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 42 42 CONTAINS 43 43 44 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)44 SUBROUTINE stp_ctl( kt, Kmm ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE stp_ctl *** … … 49 49 !! 50 50 !! ** Method : - Save the time step in numstp 51 !! - Print it each 50 time steps 52 !! - Stop the run IF problem encountered by setting indic=-3 51 !! - Stop the run IF problem encountered by setting nstop > 0 53 52 !! Problems checked: |ssh| maximum larger than 10 m 54 53 !! |U| maximum larger than 10 m/s … … 57 56 !! ** Actions : "time.step" file = last ocean time-step 58 57 !! "run.stat" file = run statistics 59 !! nstop indicator sheared among all local domain (lk_mpp=T)58 !! nstop indicator sheared among all local domain 60 59 !!---------------------------------------------------------------------- 61 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 63 INTEGER, INTENT(inout) :: kindic ! error indicator 64 !! 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 67 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 ! 74 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 76 ll_wrtruns = ll_colruns .AND. lwm 77 IF( kt == nit000 .AND. lwp ) THEN 78 WRITE(numout,*) 79 WRITE(numout,*) 'stp_ctl : time-stepping control' 80 WRITE(numout,*) '~~~~~~~' 81 ! ! open time.step file 82 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 83 ! ! open run.stat file(s) at start whatever 84 ! ! the value of sn_cfctl%ptimincr 85 IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 61 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 62 !! 63 INTEGER :: ji ! dummy loop indices 64 INTEGER :: idtime, istatus 65 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 66 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 67 REAL(wp) :: zzz ! local real 68 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 70 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 74 ! 75 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 76 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 77 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 78 ! 79 IF( kt == nit000 ) THEN 80 ! 81 IF( lwp ) THEN 82 WRITE(numout,*) 83 WRITE(numout,*) 'stp_ctl : time-stepping control' 84 WRITE(numout,*) '~~~~~~~' 85 ENDIF 86 ! ! open time.step ascii file, done only by 1st subdomain 87 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 88 ! 89 IF( ll_wrtruns ) THEN 90 ! ! open run.stat ascii file, done only by 1st subdomain 86 91 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 92 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 87 93 clname = 'run.stat.nc' 88 94 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 89 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun)90 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )91 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh)92 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu)93 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1)94 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2)95 istatus = NF90_DEF_VAR( idrun, 't_min', NF90_DOUBLE, (/ idtime /), idt1)96 istatus = NF90_DEF_VAR( idrun, 't_max', NF90_DOUBLE, (/ idtime /), idt2)95 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 96 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 97 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 99 istatus = NF90_DEF_VAR( nrunid, 's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 100 istatus = NF90_DEF_VAR( nrunid, 's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 101 istatus = NF90_DEF_VAR( nrunid, 't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 102 istatus = NF90_DEF_VAR( nrunid, 't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 97 103 IF( ln_zad_Aimp ) THEN 98 istatus = NF90_DEF_VAR( idrun, 'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1)99 istatus = NF90_DEF_VAR( idrun, 'Cu_max', NF90_DOUBLE, (/ idtime /), idc1)104 istatus = NF90_DEF_VAR( nrunid, 'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 105 istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 100 106 ENDIF 101 istatus = NF90_ENDDEF(idrun) 102 zmax(8:9) = 0._wp ! initialise to zero in case ln_zad_Aimp option is not in use 103 ENDIF 104 ENDIF 105 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 106 ! 107 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 107 istatus = NF90_ENDDEF(nrunid) 108 ENDIF 109 ! 110 ENDIF 111 ! 112 ! !== write current time step ==! 113 ! !== done only by 1st subdomain at writting timestep ==! 114 IF( lwm .AND. ll_wrtstp ) THEN 108 115 WRITE ( numstp, '(1x, i8)' ) kt 109 116 REWIND( numstp ) 110 117 ENDIF 111 ! 112 ! !== test of extrema ==! 118 ! !== test of local extrema ==! 119 ! !== done by all processes at every time step ==! 120 ! 121 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 122 llmsk(Nie1: jpi,:,:) = .FALSE. 123 llmsk(:, 1:Njs1,:) = .FALSE. 124 llmsk(:,Nje1: jpj,:) = .FALSE. 125 ! 126 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain 113 127 IF( ll_wd ) THEN 114 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) ) ) ! ssh max128 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 115 129 ELSE 116 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ) ) ! ssh max 117 ENDIF 118 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 119 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 120 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 121 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus temperature max 122 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! temperature max 123 zmax(7) = REAL( nstop , wp ) ! stop indicator 124 IF( ln_zad_Aimp ) THEN 125 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 126 zmax(9) = MAXVAL( Cu_adv(:,:,:) , mask = tmask(:,:,:) == 1._wp ) ! cell Courant no. max 127 ENDIF 128 ! 130 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 131 ENDIF 132 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 133 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ), mask = llmsk ) ! velocity max (zonal only) 134 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 135 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 136 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 137 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 138 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 139 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 140 IF( ln_zad_Aimp ) THEN 141 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 142 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 143 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = llmsk ) ! implicit vertical vel. max 144 ELSE 145 zmax(7:8) = 0._wp 146 ENDIF 147 ELSE 148 zmax(5:8) = 0._wp 149 ENDIF 150 zmax(9) = REAL( nstop, wp ) ! stop indicator 151 ! !== get global extrema ==! 152 ! !== done by all processes if writting run.stat ==! 129 153 IF( ll_colruns ) THEN 154 zmaxlocal(:) = zmax(:) 130 155 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(7) ) ! nstop indicator sheared among all local domains 132 ENDIF 133 ! !== run statistics ==! ("run.stat" files) 156 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 157 ENDIF 158 ! !== write "run.stat" files ==! 159 ! !== done only by 1st subdomain at writting timestep ==! 134 160 IF( ll_wrtruns ) THEN 135 161 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 136 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )137 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) )138 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) )139 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) )140 istatus = NF90_PUT_VAR( idrun, idt1, (/-zmax(5)/), (/kt/), (/1/) )141 istatus = NF90_PUT_VAR( idrun, idt2, (/ zmax(6)/), (/kt/), (/1/) )162 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 163 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 164 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 165 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 166 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 167 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 142 168 IF( ln_zad_Aimp ) THEN 143 istatus = NF90_PUT_VAR( idrun, idw1, (/ zmax(8)/), (/kt/), (/1/) ) 144 istatus = NF90_PUT_VAR( idrun, idc1, (/ zmax(9)/), (/kt/), (/1/) ) 145 ENDIF 146 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 147 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 169 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 171 ENDIF 172 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 148 173 END IF 149 ! !== error handling ==! 150 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 151 & zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 152 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 153 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 154 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 155 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 156 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 157 IF( lk_mpp .AND. ln_ctl ) THEN 158 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm)) , ssmask(:,:) , zzz, ih ) 159 CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)) , umask (:,:,:), zzz, iu ) 160 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 161 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 174 ! !== error handling ==! 175 ! !== done by all processes at every time step ==! 176 ! 177 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 178 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 179 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 180 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 181 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 182 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 183 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 184 ! 185 iloc(:,:) = 0 186 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 187 ! first: close the netcdf file, so we can read it 188 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 189 ! get global loc on the min/max 190 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 191 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 192 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 193 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 194 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 195 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,3) ) 196 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,4) ) 197 ! find which subdomain has the max. 198 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 199 DO ji = 1, 9 200 IF( zmaxlocal(ji) == zmax(ji) ) THEN 201 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 202 ENDIF 203 END DO 204 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 205 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 206 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 207 ELSE ! find local min and max locations: 208 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 209 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 210 iloc(1:2,1) = MAXLOC( ABS( ssh(:,:, Kmm)), mask = llmsk(:,:,1) ) 211 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 212 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) ) 213 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 214 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 215 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 216 DO ji = 1, 4 ! local domain indices ==> global domain indices, excluding halos 217 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 218 END DO 219 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 220 ENDIF 221 ! 222 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 223 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 224 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 225 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 226 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 227 IF( Agrif_Root() ) THEN 228 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 162 229 ELSE 163 ih(:) = MAXLOC( ABS( ssh(:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1 /) 164 iu(:) = MAXLOC( ABS( uu (:,:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 165 is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 166 is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 167 ENDIF 168 169 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 170 WRITE(ctmp2,9100) kt, zmax(1), ih(1) , ih(2) 171 WRITE(ctmp3,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 172 WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 173 WRITE(ctmp5,9400) kt, zmax(4), is2(1), is2(2), is2(3) 174 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 175 230 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 231 ENDIF 232 ! 176 233 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 177 178 IF( .NOT. ln_ctl ) THEN179 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea180 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6)181 ELSE182 CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )183 ENDIF184 185 kindic = -3186 !187 ENDIF188 !189 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 190 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 191 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 192 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 234 ! 235 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 236 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 237 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 238 ENDIF 239 ELSE ! only mpi subdomains with errors are here -> STOP now 240 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 241 ENDIF 242 ! 243 ENDIF 244 ! 245 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 246 ngrdstop = Agrif_Fixed() ! store which grid got this error 247 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 248 ENDIF 249 ! 193 250 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 194 251 ! 195 252 END SUBROUTINE stp_ctl 253 254 255 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 256 !!---------------------------------------------------------------------- 257 !! *** ROUTINE wrt_line *** 258 !! 259 !! ** Purpose : write information line 260 !! 261 !!---------------------------------------------------------------------- 262 CHARACTER(len=*), INTENT( out) :: cdline 263 CHARACTER(len=*), INTENT(in ) :: cdprefix 264 REAL(wp), INTENT(in ) :: pval 265 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 266 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 267 ! 268 CHARACTER(len=80) :: clsuff 269 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 270 CHARACTER(len=9 ) :: cli, clj, clk 271 CHARACTER(len=1 ) :: clfmt 272 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 273 INTEGER :: ifmtk 274 !!---------------------------------------------------------------------- 275 WRITE(clkt , '(i9)') kt 276 277 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 278 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 279 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 280 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 281 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 282 WRITE(clmax, cl4) kmax-1 283 ! 284 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 285 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 286 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 287 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 288 ! 289 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 290 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 291 ENDIF 292 IF(kloc(3) == 0) THEN 293 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 294 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 295 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 296 ELSE 297 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 298 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 299 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 300 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 301 ENDIF 302 ! 303 9100 FORMAT('MPI rank ', a) 304 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 305 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 306 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 307 ! 308 END SUBROUTINE wrt_line 309 196 310 197 311 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/trazdf.F90
r12511 r13540 35 35 PUBLIC tra_zdf_imp ! called by trczdf.F90 36 36 37 !! * Substitutions 38 # include "do_loop_substitute.h90" 37 39 !!---------------------------------------------------------------------- 38 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 77 79 ! JMM avoid negative salinities near river outlet ! Ugly fix 78 80 ! JMM : restore negative salinities to small salinities: 79 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp81 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp 80 82 !!gm 81 83 … … 95 97 ENDIF 96 98 ! ! print mean trends (used for debugging) 97 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, &98 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )99 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, & 100 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 99 101 ! 100 102 IF( ln_timing ) CALL timing_stop('tra_zdf') … … 154 156 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 155 157 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 156 DO jk = 2, jpkm1 157 DO jj = 2, jpjm1 158 DO ji = fs_2, fs_jpim1 ! vector opt. 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END DO 161 END DO 162 END DO 158 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END_3D 163 161 ELSE ! standard or triad iso-neutral operator 164 DO jk = 2, jpkm1 165 DO jj = 2, jpjm1 166 DO ji = fs_2, fs_jpim1 ! vector opt. 167 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 168 END DO 169 END DO 170 END DO 162 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 163 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 164 END_3D 171 165 ENDIF 172 166 ENDIF … … 174 168 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 175 169 IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection 176 DO jk = 1, jpkm1 177 DO jj = 2, jpjm1 178 DO ji = fs_2, fs_jpim1 ! vector opt. (ensure same order of calculation as below if wi=0.) 179 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 180 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 181 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 182 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 183 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 184 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 185 END DO 186 END DO 187 END DO 170 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 171 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 172 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 173 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 174 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 175 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 176 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 177 END_3D 188 178 ELSE 189 DO jk = 1, jpkm1 190 DO jj = 2, jpjm1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 193 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 194 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 195 END DO 196 END DO 197 END DO 179 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 180 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 181 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 182 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 183 END_3D 198 184 ENDIF 199 185 ! … … 217 203 ! used as a work space array: its value is modified. 218 204 ! 219 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 220 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) 221 zwt(ji,jj,1) = zwd(ji,jj,1) 222 END DO 223 END DO 224 DO jk = 2, jpkm1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 227 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 228 END DO 229 END DO 230 END DO 205 DO_2D( 0, 0, 0, 0 ) 206 zwt(ji,jj,1) = zwd(ji,jj,1) 207 END_2D 208 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 209 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 210 END_3D 231 211 ! 232 212 ENDIF 233 213 ! 234 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 235 DO ji = fs_2, fs_jpim1 236 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 237 END DO 238 END DO 239 DO jk = 2, jpkm1 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 242 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 243 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 244 END DO 245 END DO 246 END DO 214 DO_2D( 0, 0, 0, 0 ) 215 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 216 END_2D 217 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 218 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 219 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 220 END_3D 247 221 ! 248 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 249 DO ji = fs_2, fs_jpim1 250 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 251 END DO 252 END DO 253 DO jk = jpk-2, 1, -1 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 257 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 258 END DO 259 END DO 260 END DO 222 DO_2D( 0, 0, 0, 0 ) 223 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 224 END_2D 225 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 226 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 227 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 228 END_3D 261 229 ! ! ================= ! 262 230 END DO ! end tracer loop ! -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/usrdef_hgr.F90
r10074 r13540 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 61 63 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 62 64 ! 63 INTEGER :: ji, jj ! dummy loop indices65 INTEGER :: ji, jj ! dummy loop indices 64 66 REAL(wp) :: zphi0, zlam0, zbeta, zf0 65 REAL(wp) :: zti, z ui, ztj, zvj ! local scalars67 REAL(wp) :: zti, ztj ! local scalars 66 68 !!------------------------------------------------------------------------------- 67 69 ! … … 75 77 ! Position coordinates (in kilometers) 76 78 ! ========== 77 zlam0 = -REAL(NINT( jpiglo*rn_0xratio)-1, wp) * rn_dx78 zphi0 = -REAL(NINT( jpjglo*rn_0yratio)-1, wp) * rn_dy79 zlam0 = -REAL(NINT(Ni0glo*rn_0xratio)-1, wp) * rn_dx 80 zphi0 = -REAL(NINT(Nj0glo*rn_0yratio)-1, wp) * rn_dy 79 81 80 82 #if defined key_agrif … … 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * zti 96 plamu(ji,jj) = zlam0 + rn_dx * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D( 1, 1, 1, 1 ) 93 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 94 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 95 96 plamt(ji,jj) = zlam0 + rn_dx * zti 97 plamu(ji,jj) = zlam0 + rn_dx * ( zti + 0.5_wp ) 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * ( ztj + 0.5_wp ) 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 ! 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/usrdef_istate.F90
r12511 r13540 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 64 66 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 65 67 ! 66 IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom)67 68 zjetx = ABS(rn_ujetszx)/2. 68 69 zjety = ABS(rn_ujetszy)/2. 69 70 ! 71 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 72 ! 70 73 SELECT CASE(nn_initcase) 74 75 CASE(-1) ! stratif at rest 76 77 ! sea level: 78 pssh(:,:) = 0. 79 ! temperature: 80 pts(:,:,1,jp_tem) = 25. !!30._wp 81 pts(:,:,2:jpk,jp_tem) = 22. !!24._wp 82 ! salinity: 83 pts(:,:,:,jp_sal) = 35._wp 84 ! velocities: 85 pu(:,:,:) = 0. 86 pv(:,:,:) = 0. 87 71 88 CASE(0) ! rest 72 89 … … 96 113 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 97 114 WHERE( ABS(gphit) <= zjety ) 98 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:)* gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 )99 ELSEWHERE 100 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:)* SIGN(zjety, gphit(:,:)) * 1.e3 &115 pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 116 ELSEWHERE 117 pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 & 101 118 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 102 119 END WHERE … … 107 124 pts(:,:,jpk,jp_sal) = 0. 108 125 DO jk=1, jpkm1 109 pts(:,:,jk,jp_sal) = gphit(:,:) 126 WHERE( ABS(gphit) <= zjety ) 127 !!$ WHERE( ABS(gphit) <= zjety*0.5 .AND. ABS(glamt) <= zjety*0.5 ) ! for a square of salt 128 pts(:,:,jk,jp_sal) = 35. 129 ELSEWHERE 130 pts(:,:,jk,jp_sal) = 30. 131 END WHERE 110 132 END DO 111 133 ! velocities: … … 132 154 WHERE( ABS(gphit) <= zjety ) 133 155 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 134 & * ( ff_t(:,:)* gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 )156 & * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 135 157 ELSEWHERE 136 158 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 137 & * ( ff_t(:,:)* SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 )159 & * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 138 160 END WHERE 139 161 END SELECT … … 141 163 pts(:,:,:,jp_tem) = 10._wp 142 164 ! salinity: 143 pts(:,:,:,jp_sal) = 2.144 DO jk=1, jpkm1 145 WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 2. + SIGN(1.,gphiv(:,:))165 pts(:,:,:,jp_sal) = 30. 166 DO jk=1, jpkm1 167 WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 30. + SIGN(1.,gphiv(:,:)) 146 168 END DO 147 169 ! velocities: … … 164 186 pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 165 187 DO jl=1, jpnj 166 DO jj=nldj, nlej 167 DO ji=nldi, nlei 168 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 169 END DO 170 END DO 188 DO_2D( 0, 0, 0, 0 ) 189 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 190 END_2D 171 191 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 172 192 END DO … … 176 196 ! salinity: 177 197 DO jk=1, jpkm1 178 pts(:,:,jk,jp_sal) = gphit(:,:)198 pts(:,:,jk,jp_sal) = pssh(:,:) 179 199 END DO 180 200 ! velocities: … … 183 203 CASE(4) ! geostrophic zonal pulse 184 204 185 DO jj=1, jpj 186 DO ji=1, jpi 187 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 188 zdu = rn_uzonal 189 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 190 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 191 ELSE 192 zdu = 0. 193 END IF 194 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 195 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 196 pu(ji,jj,:) = zdu 197 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 198 ELSE 199 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 200 pu(ji,jj,:) = 0. 201 pts(ji,jj,:,jp_sal) = 1. 202 END IF 203 END DO 204 END DO 205 DO_2D( 1, 1, 1, 1 ) 206 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 207 zdu = rn_uzonal 208 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 209 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 210 ELSE 211 zdu = 0. 212 END IF 213 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 214 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 215 pu(ji,jj,:) = zdu 216 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 217 ELSE 218 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 219 pu(ji,jj,:) = 0. 220 pts(ji,jj,:,jp_sal) = 1. 221 END IF 222 END_2D 205 223 206 224 ! temperature: 207 225 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 208 226 pv(:,:,:) = 0. 209 210 227 211 228 CASE(5) ! vortex … … 213 230 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 214 231 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 215 zlambda = SQRT(2._wp)*rn_lambda ! Horizontal scale in meters232 zlambda = SQRT(2._wp)*rn_lambda*1.e3 ! Horizontal scale in meters 216 233 zn2 = 3.e-3**2 217 234 zH = 0.5_wp * 5000._wp … … 220 237 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 221 238 ! 222 DO jj=1, jpj 223 DO ji=1, jpi 224 zx = glamt(ji,jj) * 1.e3 225 zy = gphit(ji,jj) * 1.e3 226 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 227 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 228 ! Sea level: 229 pssh(ji,jj) = 0. 230 DO jl=1,5 231 zdt = pssh(ji,jj) 232 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 233 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 234 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 235 END DO 236 ! temperature: 237 DO jk=1,jpk 238 zdt = pdept(ji,jj,jk) 239 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 240 IF (zdt < zH) THEN 241 zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH)) ! F'(z) 242 zrho1 = zrho1 - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 243 ENDIF 244 ! pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 245 pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 246 END DO 239 DO_2D( 1, 1, 1, 1 ) 240 zx = glamt(ji,jj) * 1.e3 241 zy = gphit(ji,jj) * 1.e3 242 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 243 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 244 ! Sea level: 245 pssh(ji,jj) = 0. 246 DO jl=1,5 247 zdt = pssh(ji,jj) 248 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 249 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 250 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 247 251 END DO 248 END DO 252 ! temperature: 253 DO jk=1,jpk 254 zdt = pdept(ji,jj,jk) 255 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 256 IF (zdt < zH) THEN 257 zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH)) ! F'(z) 258 zrho1 = zrho1 - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 259 ENDIF 260 ! pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 261 pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 262 END DO 263 END_2D 249 264 ! 250 265 ! salinity: … … 253 268 ! velocities: 254 269 za = 2._wp * zP0 / zlambda**2 255 DO jj=1, jpj 256 DO ji=1, jpim1 257 zx = glamu(ji,jj) * 1.e3 258 zy = gphiu(ji,jj) * 1.e3 259 DO jk=1, jpk 260 zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 261 IF (zdu < zH) THEN 262 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 263 zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 264 pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 265 ELSE 266 pu(ji,jj,jk) = 0._wp 267 ENDIF 268 END DO 270 DO_2D( 0, 0, 0, 0 ) 271 zx = glamu(ji,jj) * 1.e3 272 zy = gphiu(ji,jj) * 1.e3 273 DO jk=1, jpk 274 zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 275 IF (zdu < zH) THEN 276 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 277 zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 278 pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 279 ELSE 280 pu(ji,jj,jk) = 0._wp 281 ENDIF 269 282 END DO 270 END DO 271 ! 272 DO jj=1, jpjm1 273 DO ji=1, jpi 274 zx = glamv(ji,jj) * 1.e3 275 zy = gphiv(ji,jj) * 1.e3 276 DO jk=1, jpk 277 zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 278 IF (zdv < zH) THEN 279 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 280 zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 281 pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 282 ELSE 283 pv(ji,jj,jk) = 0._wp 284 ENDIF 285 END DO 283 END_2D 284 ! 285 DO_2D( 0, 0, 0, 0 ) 286 zx = glamv(ji,jj) * 1.e3 287 zy = gphiv(ji,jj) * 1.e3 288 DO jk=1, jpk 289 zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 290 IF (zdv < zH) THEN 291 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 292 zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 293 pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 294 ELSE 295 pv(ji,jj,jk) = 0._wp 296 ENDIF 286 297 END DO 287 END DO298 END_2D 288 299 ! 289 300 END SELECT 290 301 291 302 IF (ln_sshnoise) THEN 303 CALL RANDOM_SEED() 292 304 CALL RANDOM_NUMBER(zrandom) 293 305 pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 ) 294 306 END IF 295 307 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 296 CALL lbc_lnk( 'usrdef_istate', pts, 'T', 1. ) 297 CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 298 CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 308 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 309 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 299 310 300 311 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain16 USE dom_oce 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants … … 50 50 LOGICAL , PUBLIC :: ln_sshnoise=.false. ! add random noise on initial ssh 51 51 REAL(wp), PUBLIC :: rn_lambda = 50. ! gaussian lambda 52 INTEGER , PUBLIC :: nn_perio = 0 ! periodicity of the channel (0=closed, 1=E-W) 52 53 53 54 !!---------------------------------------------------------------------- … … 79 80 !! 80 81 NAMELIST/namusr_def/ rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio & 81 & , nn_fcase, rn_ppgphi0, rn_ vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy&82 & , rn_ u10, rn_windszx, rn_windszy, rn_uofac&83 & , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda 82 & , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac & 83 & , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy & 84 & , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio 84 85 !!---------------------------------------------------------------------- 85 86 ! … … 106 107 kk_cfg = INT( rn_dx ) 107 108 ! 108 ! Global Domain size: EW_CANAL global domain is 1800 km x 1800 Km x 5000 m 109 kpi = NINT( rn_domszx / rn_dx ) + 1 110 kpj = NINT( rn_domszy / rn_dy ) + 3 111 kpk = NINT( rn_domszz / rn_dz ) + 1 112 #if defined key_agrif 113 IF( .NOT. Agrif_Root() ) THEN 114 kpi = nbcellsx + 2 + 2*nbghostcells 115 kpj = nbcellsy + 2 + 2*nbghostcells 109 IF( Agrif_Root() ) THEN ! Global Domain size: EW_CANAL global domain is 1800 km x 1800 Km x 5000 m 110 kpi = NINT( rn_domszx / rn_dx ) + 1 111 kpj = NINT( rn_domszy / rn_dy ) + 3 112 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 113 kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 114 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 116 115 ENDIF 117 #endif 116 kpk = MAX( 2, NINT( rn_domszz / rn_dz ) + 1 ) 118 117 ! 119 118 zh = (kpk-1)*rn_dz … … 150 149 WRITE(numout,*) ' add random noise on initial ssh ln_sshnoise= ', ln_sshnoise 151 150 WRITE(numout,*) ' Gaussian lambda parameter rn_lambda = ', rn_lambda 152 WRITE(numout,*) ' ' 153 WRITE(numout,*) ' Lateral boundary condition of the global domain' 154 WRITE(numout,*) ' EW_CANAL : closed basin jperio = ', kperio 151 WRITE(numout,*) ' Periodicity of the basin nn_perio = ', nn_perio 155 152 ENDIF 153 ! ! Set the lateral boundary condition of the global domain 154 kperio = nn_perio ! EW_CANAL configuration : closed basin 156 155 ! 157 156 END SUBROUTINE usr_def_nam -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/usrdef_sbc.F90
r12377 r13540 17 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 18 USE phycst ! physical constants 19 USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy 19 USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy, rn_windszx 20 20 ! 21 21 USE in_out_manager ! I/O manager … … 38 38 CONTAINS 39 39 40 SUBROUTINE usrdef_sbc_oce( kt, K mm, Kbb )40 SUBROUTINE usrdef_sbc_oce( kt, Kbb ) 41 41 !!--------------------------------------------------------------------- 42 42 !! *** ROUTINE usr_def_sbc *** … … 53 53 !!---------------------------------------------------------------------- 54 54 INTEGER, INTENT(in) :: kt ! ocean time step 55 INTEGER, INTENT(in) :: Kbb , Kmm! ocean time index55 INTEGER, INTENT(in) :: Kbb ! ocean time index 56 56 INTEGER :: ji, jj ! dummy loop indices 57 57 REAL(wp) :: zrhoair = 1.22 ! approximate air density [Kg/m3] … … 69 69 ! 70 70 utau(:,:) = 0._wp 71 IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN72 WHERE( ABS(gphit) <= rn_windszy/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u1073 ENDIF74 71 vtau(:,:) = 0._wp 75 72 taum(:,:) = 0._wp … … 83 80 ENDIF 84 81 82 IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 83 IF( nyear == 1 .AND. nmonth == 1 .AND. nday <= 10 ) THEN 84 WHERE( ABS(gphit) <= rn_windszy/2. .AND. ABS(glamt) <= rn_windszx/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 85 ELSE 86 utau(:,:) = 0. 87 ENDIF 88 ENDIF 89 85 90 IF( rn_uofac /= 0. ) THEN 86 91 87 92 WHERE( ABS(gphit) <= rn_windszy/2. ) 88 zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,K mm)93 zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kbb) 89 94 ELSEWHERE 90 zwndrel(:,:) = - rn_uofac * uu(:,:,1,K mm)95 zwndrel(:,:) = - rn_uofac * uu(:,:,1,Kbb) 91 96 END WHERE 92 97 utau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 93 98 94 zwndrel(:,:) = - rn_uofac * vv(:,:,1,K mm)99 zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kbb) 95 100 vtau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 96 101 -
NEMO/branches/2020/r12377_ticket2386/tests/CANAL/MY_SRC/usrdef_zgr.F90
r12377 r13540 197 197 zmaxlam = MAXVAL(glamt) 198 198 CALL mpp_max( 'usrdef_zgr', zmaxlam ) ! max over the global domain 199 zscl = rpi / zmaxlam200 z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ))201 z2d(:,:) = REAL(jpkm1 - NINT( 0. 75 * REAL(jpkm1,wp) * z2d(:,:) ), wp)199 zscl = 0.5 * rpi / zmaxlam 200 z2d(:,:) = COS( glamt(:,:) * zscl ) 201 z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 202 202 END SELECT 203 203 ! 204 204 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 205 205 ! 206 k_bot(:,:) = INT( z2d(:,:) )! =jpkm1 over the ocean point, =0 elsewhere206 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 207 207 ! 208 208 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_cfg
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_cfg_120pts
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_cfg_240pts
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_cfg_60pts
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg
r10535 r13540 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_60pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_120pts
r10431 r13540 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_120pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_240pts
r10431 r13540 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_240pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_60pts
r10431 r13540 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_60pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
r10513 r13540 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 62 64 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 63 65 ! 64 INTEGER :: ji, jj ! dummy loop indices66 INTEGER :: ji, jj ! dummy loop indices 65 67 REAL(wp) :: zphi0, zlam0, zbeta, zf0 66 REAL(wp) :: zti, z ui, ztj, zvj ! local scalars68 REAL(wp) :: zti, ztj ! local scalars 67 69 !!------------------------------------------------------------------------------- 68 70 ! … … 73 75 74 76 ! ========== 75 zlam0 = - (jpiglo-1)/2* 1.e-3 * rn_dx76 zphi0 = - (jpjglo-1)/2* 1.e-3 * rn_dy77 zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 78 zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy 77 79 78 DO jj = 1, jpj 79 DO ji = 1, jpi 80 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 81 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 82 83 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 84 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 85 plamv(ji,jj) = plamt(ji,jj) 86 plamf(ji,jj) = plamu(ji,jj) 87 88 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 89 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 90 pphiu(ji,jj) = pphit(ji,jj) 91 pphif(ji,jj) = pphiv(ji,jj) 92 END DO 93 END DO 80 DO_2D( 1, 1, 1, 1 ) 81 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 82 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 83 84 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 85 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 86 plamv(ji,jj) = plamt(ji,jj) 87 plamf(ji,jj) = plamu(ji,jj) 88 89 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 90 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 91 pphiu(ji,jj) = pphit(ji,jj) 92 pphif(ji,jj) = pphiv(ji,jj) 93 END_2D 94 94 95 95 ! constant scale factors -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain17 16 USE par_oce ! ocean space and time domain 18 17 USE phycst ! physical constants … … 91 90 WRITE(numout,*) ' LX [km]: ', zlx 92 91 WRITE(numout,*) ' LY [km]: ', zly 93 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi94 WRITE(numout,*) ' jpjglo = ', kpj92 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 93 WRITE(numout,*) ' Nj0glo = ', kpj 95 94 WRITE(numout,*) ' jpkglo = ', kpk 96 95 WRITE(numout,*) ' Coriolis:', ln_corio -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV1D/MY_SRC/usrdef_sbc.F90
r12377 r13540 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 153 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 157 158 154 159 END SUBROUTINE usrdef_sbc_ice_flx 155 160 -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/EXPREF/namelist_cfg
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/EXPREF/namelist_ice_cfg
r10535 r13540 86 86 !------------------------------------------------------------------------------ 87 87 ln_iceini = .true. ! activate ice initialization (T) or not (F) 88 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)88 nn_iceini_file = 1 ! netcdf file provided for initialization 89 89 90 90 sn_hti = 'initice' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
r10515 r13540 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 62 64 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 63 65 ! 64 INTEGER :: ji, jj ! dummy loop indices66 INTEGER :: ji, jj ! dummy loop indices 65 67 REAL(wp) :: zphi0, zlam0, zbeta, zf0 66 REAL(wp) :: zti, z ui, ztj, zvj ! local scalars68 REAL(wp) :: zti, ztj ! local scalars 67 69 !!------------------------------------------------------------------------------- 68 70 ! … … 74 76 75 77 ! ========== 76 zlam0 = - (jpiglo-1)/2* 1.e-3 * rn_dx77 zphi0 = - (jpjglo-1)/2 * 1.e-3 * rn_dy78 zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 79 zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy 78 80 79 81 #if defined key_agrif … … 81 83 !clem zlam0 = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 82 84 !clem zphi0 = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 83 zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2) * 1.e-3 * Agrif_irhox() * rn_dx &85 zlam0 = ( 0.5_wp - REAL( (Agrif_parent(Ni0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhox() * rn_dx & 84 86 & + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 85 zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2) * 1.e-3 * Agrif_irhoy() * rn_dy &87 zphi0 = ( 0.5_wp - REAL( (Agrif_parent(Nj0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhoy() * rn_dy & 86 88 & + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 87 89 ENDIF 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D( 1, 1, 1, 1 ) 93 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 94 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 95 96 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 97 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain16 USE dom_oce 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants … … 82 82 kk_cfg = NINT( rn_dx ) 83 83 ! 84 IF( Agrif_Root() ) THEN ! Global Domain size: 84 IF( Agrif_Root() ) THEN ! Global Domain size: ICE_AGRIF domain is 300 km x 300 Km x 10 m 85 85 kpi = NINT( 300.e3 / rn_dx ) - 1 86 86 kpj = NINT( 300.e3 / rn_dy ) - 1 87 ELSE 88 kpi = nbcellsx + 2 + 2*nbghostcells89 kpj = nbcellsy + 2 + 2*nbghostcells87 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 88 kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 89 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 90 90 ENDIF 91 kpk = 191 kpk = 2 92 92 ! 93 93 !! zlx = (kpi-2)*rn_dx*1.e-3 … … 110 110 WRITE(numout,*) ' LX [km]: ', zlx 111 111 WRITE(numout,*) ' LY [km]: ', zly 112 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi113 WRITE(numout,*) ' jpjglo = ', kpj112 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 113 WRITE(numout,*) ' Nj0glo = ', kpj 114 114 WRITE(numout,*) ' jpkglo = ', kpk 115 115 WRITE(numout,*) ' Coriolis:', ln_corio -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90
r12377 r13540 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 153 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 157 158 154 159 END SUBROUTINE usrdef_sbc_ice_flx 155 160 -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/EXPREF/1_namelist_cfg
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/EXPREF/AGRIF_FixedGrids.in
r9159 r13540 1 1 1 2 3 4 63 34 633 3 32 33 62 33 62 3 3 3 3 3 0 -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/EXPREF/context_nemo.xml
r12377 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/EXPREF/namelist_cfg
r12511 r13540 106 106 !! !! 107 107 !! namdrg top/bottom drag coefficient (default: NO selection) 108 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)109 !! namdrg_bot bottom friction (ln_ OFF=F)108 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 109 !! namdrg_bot bottom friction (ln_drg_OFF=F) 110 110 !! nambbc bottom temperature boundary condition (default: OFF) 111 111 !! nambbl bottom boundary layer scheme (default: OFF) … … 115 115 &namdrg ! top/bottom drag coefficient (default: NO selection) 116 116 !----------------------------------------------------------------------- 117 ln_ OFF = .true. ! free-slip : Cd = 0117 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 118 118 / 119 119 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/EXPREF/namelist_ice_cfg
r10535 r13540 86 86 !------------------------------------------------------------------------------ 87 87 ln_iceini = .true. ! activate ice initialization (T) or not (F) 88 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)88 nn_iceini_file = 1 ! netcdf file provided for initialization 89 89 90 90 sn_hti = 'initice' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
r10516 r13540 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 62 64 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 63 65 ! 64 INTEGER :: ji, jj ! dummy loop indices66 INTEGER :: ji, jj ! dummy loop indices 65 67 REAL(wp) :: zphi0, zlam0, zbeta, zf0 66 REAL(wp) :: zti, z ui, ztj, zvj ! local scalars68 REAL(wp) :: zti, ztj ! local scalars 67 69 !!------------------------------------------------------------------------------- 68 70 ! … … 74 76 75 77 ! ========== 76 zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx77 zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy78 79 78 #if defined key_agrif 80 IF( .NOT. Agrif_Root() ) THEN 79 IF( Agrif_Root() ) THEN 80 #endif 81 ! Compatibility WITH old version: 82 ! jperio = 7 => Ni0glo = jpigo_old_version - 2 83 ! => jpiglo-1 replaced by Ni0glo+1 84 zlam0 = -REAL( (Ni0glo+1)/2, wp) * 1.e-3 * rn_dx 85 zphi0 = -REAL( (Nj0glo+1)/2, wp) * 1.e-3 * rn_dy ! +1 for compatibility with old version --> to be replaced by -1 as before 86 #if defined key_agrif 87 ELSE 88 ! ! let lower left longitude and latitude from parent 81 89 !clem zlam0 = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 82 90 !clem zphi0 = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 83 zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhox() * rn_dx & 91 ! Compatibility WITH old version: 92 ! jperio = 0 => Ni0glo = jpigo_old_version 93 ! => Agrif_parent(jpiglo)-1 replaced by Agrif_parent(Ni0glo)-1 94 zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx & 84 95 & + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 85 zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2) * 1.e-3 * Agrif_irhoy() * rn_dy &96 zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy & 86 97 & + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 87 98 ENDIF 88 99 #endif 89 100 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 101 DO_2D( 1, 1, 1, 1 ) 102 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 103 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 104 105 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 106 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 107 plamv(ji,jj) = plamt(ji,jj) 108 plamf(ji,jj) = plamu(ji,jj) 109 110 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 111 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 112 pphiu(ji,jj) = pphit(ji,jj) 113 pphif(ji,jj) = pphiv(ji,jj) 114 END_2D 106 115 107 116 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain16 USE dom_oce 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants … … 85 85 kpi = NINT( 300.e3 / rn_dx ) - 1 86 86 kpj = NINT( 300.e3 / rn_dy ) - 1 87 ELSE 88 kpi = nbcellsx + 2 + 2*nbghostcells 89 kpj = nbcellsy + 2 + 2*nbghostcells 87 kpi = kpi - 2 ! for compatibility with old version (because kerio=7) --> to be removed 88 kpj = kpj - 2 ! for compatibility with old version (because kerio=7) --> to be removed 89 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 90 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) 91 kpj = nbcellsy + 2 * ( nbghostcells + 1 ) 92 !!$ kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 93 !!$ kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 90 94 ENDIF 91 kpk = 195 kpk = 2 92 96 ! 93 97 !! zlx = (kpi-2)*rn_dx*1.e-3 … … 110 114 WRITE(numout,*) ' LX [km]: ', zlx 111 115 WRITE(numout,*) ' LY [km]: ', zly 112 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi113 WRITE(numout,*) ' jpjglo = ', kpj116 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 117 WRITE(numout,*) ' Nj0glo = ', kpj 114 118 WRITE(numout,*) ' jpkglo = ', kpk 115 119 WRITE(numout,*) ' Coriolis:', ln_corio -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
r12377 r13540 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 153 157 154 158 END SUBROUTINE usrdef_sbc_ice_flx -
NEMO/branches/2020/r12377_ticket2386/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90
r12377 r13540 89 89 ! !== z-coordinate ==! (step-like topography) 90 90 ! !* bottom ocean compute from the depth of grid-points 91 jpkm1 = jpk 91 jpkm1 = jpk-1 92 92 k_bot(:,:) = 1 ! here use k_top as a land mask 93 93 ! !* horizontally uniform coordinate (reference z-co everywhere) -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml
r11889 r13540 21 21 <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files --> 22 22 23 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 24 <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" > 25 <field field_ref="toce" name="votemper" /> 26 <field field_ref="soce" name="vosaline" /> 27 <field field_ref="ssh" name="sossheig" /> 23 <file id="file1" output_freq="5d" name_suffix="_grid_T" description="ocean T grid variables" > 24 <field field_ref="toce" name="votemper" operation="average" freq_op="5d" > @toce_e3t / @e3t </field> 25 <field field_ref="soce" name="vosaline" operation="average" freq_op="5d" > @soce_e3t / @e3t </field> 26 <field field_ref="ssh" name="sossheig" /> 28 27 <!-- variable for ice shelf --> 29 <field field_ref="fwfisf_cav" 30 <field field_ref="isfgammat" 31 <field field_ref="isfgammas" 28 <field field_ref="fwfisf_cav" name="sowflisf" /> 29 <field field_ref="isfgammat" name="sogammat" /> 30 <field field_ref="isfgammas" name="sogammas" /> 32 31 <field field_ref="ttbl_cav" name="ttbl" /> 33 <field field_ref="stbl" name="stbl" />34 <field field_ref="utbl" name="utbl" />35 <field field_ref="vtbl" name="vtbl" />32 <field field_ref="stbl" name="stbl" /> 33 <field field_ref="utbl" name="utbl" /> 34 <field field_ref="vtbl" name="vtbl" /> 36 35 </file> 37 <file id="file2" output_freq=" 1mo" name_suffix="_grid_U" description="ocean U grid variables" >38 <field field_ref="uoce" name="vozocrtx" />36 <file id="file2" output_freq="5d" name_suffix="_grid_U" description="ocean U grid variables" > 37 <field field_ref="uoce" name="vozocrtx" operation="average" freq_op="5d" > @uoce_e3u / @e3u </field> /> 39 38 </file> 40 <file id="file3" output_freq=" 1mo" name_suffix="_grid_V" description="ocean V grid variables" >41 <field field_ref="voce" name="vomecrty" />39 <file id="file3" output_freq="5d" name_suffix="_grid_V" description="ocean V grid variables" > 40 <field field_ref="voce" name="vomecrty" operation="average" freq_op="5d" > @voce_e3v / @e3v </field> /> 42 41 </file> 43 42 </file_group> 43 44 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 44 45 <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 45 46 <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/EXPREF/namelist_cfg
r12511 r13540 114 114 115 115 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 116 nn_fwb = 1116 nn_fwb = 4 117 117 / 118 118 !----------------------------------------------------------------------- … … 261 261 !! !! 262 262 !! namdrg top/bottom drag coefficient (default: NO selection) 263 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)264 !! namdrg_bot bottom friction (ln_ OFF=F)263 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 264 !! namdrg_bot bottom friction (ln_drg_OFF=F) 265 265 !! nambbc bottom temperature boundary condition (default: OFF) 266 266 !! nambbl bottom boundary layer scheme (default: OFF) … … 273 273 / 274 274 !----------------------------------------------------------------------- 275 &namdrg_top ! TOP friction (ln_ OFF =F & ln_isfcav=T)275 &namdrg_top ! TOP friction (ln_drg_OFF =F & ln_isfcav=T) 276 276 !----------------------------------------------------------------------- 277 277 rn_Cd0 = 2.5e-3 ! drag coefficient [-] … … 279 279 / 280 280 !----------------------------------------------------------------------- 281 &namdrg_bot ! BOTTOM friction (ln_ OFF =F)281 &namdrg_bot ! BOTTOM friction (ln_drg_OFF =F) 282 282 !----------------------------------------------------------------------- 283 283 rn_Cd0 = 2.5e-3 ! drag coefficient [-] … … 308 308 &nameos ! ocean Equation Of Seawater (default: NO selection) 309 309 !----------------------------------------------------------------------- 310 ln_teos10 = .false. ! = Use TEOS-10 311 ln_eos80 = .false. ! = Use EOS80 312 ln_leos = .true. ! = Use S-EOS (simplified Eq.) 310 ln_leos = .true. ! = Use L-EOS (linear Eq.) 313 311 ! 314 312 ! ! S-EOS coefficients (ln_seos=T): 315 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS313 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 316 314 ! ! L-EOS coefficients (ln_seos=T): 317 ! ! rd(T,S,Z)*r au0 = rau0*(-a0*dT+b0*dS)315 ! ! rd(T,S,Z)*rho0 = rho0*(-a0*dT+b0*dS) 318 316 rn_a0 = 3.7330e-5 ! thermal expension coefficient 319 317 rn_b0 = 7.8430e-4 ! saline expension coefficient -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/dtatsd.F90
r12077 r13540 36 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsddmp ! structure of input SST (file informations, fields read) 37 37 38 !! * Substitutions 39 # include "do_loop_substitute.h90" 38 40 !!---------------------------------------------------------------------- 39 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 67 69 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 68 70 ! 69 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :70 71 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 71 72 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 72 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run73 73 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 74 74 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) … … 191 191 ENDIF 192 192 ! 193 DO jj = 1, jpj ! vertical interpolation of T & S 194 DO ji = 1, jpi 195 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 196 zl = gdept_0(ji,jj,jk) 197 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 199 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 200 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 201 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 202 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 203 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 204 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 205 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 206 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 207 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 208 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 209 ENDIF 210 END DO 211 ENDIF 212 END DO 213 DO jk = 1, jpkm1 214 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 215 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 216 END DO 217 ptsd(ji,jj,jpk,jp_tem) = 0._wp 218 ptsd(ji,jj,jpk,jp_sal) = 0._wp 193 DO_2D( 1, 1, 1, 1 ) 194 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 195 zl = gdept_0(ji,jj,jk) 196 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 197 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 198 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 199 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 201 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 202 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 203 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 204 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 205 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 206 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 207 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 208 ENDIF 209 END DO 210 ENDIF 219 211 END DO 220 END DO 212 DO jk = 1, jpkm1 213 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 214 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 215 END DO 216 ptsd(ji,jj,jpk,jp_tem) = 0._wp 217 ptsd(ji,jj,jpk,jp_sal) = 0._wp 218 END_2D 221 219 ! 222 220 ELSE !== z- or zps- coordinate ==! … … 226 224 ! 227 225 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ik = mbkt(ji,jj) 231 IF( ik > 1 ) THEN 232 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 233 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 234 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 235 ENDIF 236 ik = mikt(ji,jj) 237 IF( ik > 1 ) THEN 238 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 239 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 240 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 241 END IF 242 END DO 243 END DO 226 DO_2D( 1, 1, 1, 1 ) 227 ik = mbkt(ji,jj) 228 IF( ik > 1 ) THEN 229 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 230 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 231 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 232 ENDIF 233 ik = mikt(ji,jj) 234 IF( ik > 1 ) THEN 235 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 236 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 237 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 238 END IF 239 END_2D 244 240 ENDIF 245 241 ! -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/eosbn2.F90
r12511 r13540 180 180 REAL(wp) :: BPE002 181 181 182 !! * Substitutions 183 # include "do_loop_substitute.h90" 182 184 !!---------------------------------------------------------------------- 183 185 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 241 243 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 242 244 ! 243 DO jk = 1, jpkm1 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 245 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 251 ! 252 zn3 = EOS013*zt & 253 & + EOS103*zs+EOS003 254 ! 255 zn2 = (EOS022*zt & 256 & + EOS112*zs+EOS012)*zt & 257 & + (EOS202*zs+EOS102)*zs+EOS002 258 ! 259 zn1 = (((EOS041*zt & 260 & + EOS131*zs+EOS031)*zt & 261 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 262 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 263 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 ! 265 zn0 = (((((EOS060*zt & 266 & + EOS150*zs+EOS050)*zt & 267 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 268 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 269 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 270 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 271 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 274 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 277 END_3D 278 ! 279 CASE( np_seos ) !== simplified EOS ==! 280 ! 281 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 282 zt = pts (ji,jj,jk,jp_tem) - 10._wp 283 zs = pts (ji,jj,jk,jp_sal) - 35._wp 284 zh = pdep (ji,jj,jk) 285 ztm = tmask(ji,jj,jk) 286 ! 287 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 288 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 289 & - rn_nu * zt * zs 290 ! 291 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 292 END_3D 293 ! 294 CASE( np_leos ) !== linear ISOMIP EOS ==! 295 ! 296 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 297 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 298 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 299 zh = pdep (ji,jj,jk) 300 ztm = tmask(ji,jj,jk) 301 ! 302 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 303 ! 304 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 305 END_3D 306 ! 307 END SELECT 308 ! 309 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 310 ! 311 IF( ln_timing ) CALL timing_stop('eos-insitu') 312 ! 313 END SUBROUTINE eos_insitu 314 315 316 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 317 !!---------------------------------------------------------------------- 318 !! *** ROUTINE eos_insitu_pot *** 319 !! 320 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 321 !! potential volumic mass (Kg/m3) from potential temperature and 322 !! salinity fields using an equation of state selected in the 323 !! namelist. 324 !! 325 !! ** Action : - prd , the in situ density (no units) 326 !! - prhop, the potential volumic mass (Kg/m3) 327 !! 328 !!---------------------------------------------------------------------- 329 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 330 ! ! 2 : salinity [psu] 331 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 332 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 333 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 334 ! 335 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 336 INTEGER :: jdof 337 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 338 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 339 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 340 !!---------------------------------------------------------------------- 341 ! 342 IF( ln_timing ) CALL timing_start('eos-pot') 343 ! 344 SELECT CASE ( neos ) 345 ! 346 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 347 ! 348 ! Stochastic equation of state 349 IF ( ln_sto_eos ) THEN 350 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 351 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 352 ALLOCATE(zsign(1:2*nn_sto_eos)) 353 DO jsmp = 1, 2*nn_sto_eos, 2 354 zsign(jsmp) = 1._wp 355 zsign(jsmp+1) = -1._wp 356 END DO 357 ! 358 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 359 ! 360 ! compute density (2*nn_sto_eos) times: 361 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 362 ! (2) for t-dt, s-ds (with the opposite fluctuation) 363 DO jsmp = 1, nn_sto_eos*2 364 jdof = (jsmp + 1) / 2 365 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 366 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 367 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 368 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 369 ztm = tmask(ji,jj,jk) ! tmask 251 370 ! 252 371 zn3 = EOS013*zt & … … 263 382 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 383 ! 265 zn0 = (((((EOS060*zt &384 zn0_sto(jsmp) = (((((EOS060*zt & 266 385 & + EOS150*zs+EOS050)*zt & 267 386 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & … … 271 390 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 391 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 392 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 393 END DO 394 ! 395 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 396 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 397 DO jsmp = 1, nn_sto_eos*2 398 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 274 399 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 400 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 277 401 END DO 278 END DO 279 END DO 280 ! 281 CASE( np_seos ) !== simplified EOS ==! 282 ! 283 DO jk = 1, jpkm1 284 DO jj = 1, jpj 285 DO ji = 1, jpi 286 zt = pts (ji,jj,jk,jp_tem) - 10._wp 287 zs = pts (ji,jj,jk,jp_sal) - 35._wp 288 zh = pdep (ji,jj,jk) 289 ztm = tmask(ji,jj,jk) 290 ! 291 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 292 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 293 & - rn_nu * zt * zs 294 ! 295 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 296 END DO 297 END DO 298 END DO 299 ! 300 CASE( np_leos ) !== linear ISOMIP EOS ==! 301 ! 302 DO jk = 1, jpkm1 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 306 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 307 zh = pdep (ji,jj,jk) 308 ztm = tmask(ji,jj,jk) 309 ! 310 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 311 ! 312 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 313 END DO 314 END DO 315 END DO 316 ! 317 END SELECT 318 ! 319 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 320 ! 321 IF( ln_timing ) CALL timing_stop('eos-insitu') 322 ! 323 END SUBROUTINE eos_insitu 324 325 326 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 327 !!---------------------------------------------------------------------- 328 !! *** ROUTINE eos_insitu_pot *** 329 !! 330 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 331 !! potential volumic mass (Kg/m3) from potential temperature and 332 !! salinity fields using an equation of state selected in the 333 !! namelist. 334 !! 335 !! ** Action : - prd , the in situ density (no units) 336 !! - prhop, the potential volumic mass (Kg/m3) 337 !! 338 !!---------------------------------------------------------------------- 339 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 340 ! ! 2 : salinity [psu] 341 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 342 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 343 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 344 ! 345 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 346 INTEGER :: jdof 347 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 348 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 349 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 350 !!---------------------------------------------------------------------- 351 ! 352 IF( ln_timing ) CALL timing_start('eos-pot') 353 ! 354 SELECT CASE ( neos ) 355 ! 356 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 357 ! 358 ! Stochastic equation of state 359 IF ( ln_sto_eos ) THEN 360 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 361 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 362 ALLOCATE(zsign(1:2*nn_sto_eos)) 363 DO jsmp = 1, 2*nn_sto_eos, 2 364 zsign(jsmp) = 1._wp 365 zsign(jsmp+1) = -1._wp 366 END DO 367 ! 368 DO jk = 1, jpkm1 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 ! 372 ! compute density (2*nn_sto_eos) times: 373 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 374 ! (2) for t-dt, s-ds (with the opposite fluctuation) 375 DO jsmp = 1, nn_sto_eos*2 376 jdof = (jsmp + 1) / 2 377 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 378 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 379 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 380 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 381 ztm = tmask(ji,jj,jk) ! tmask 382 ! 383 zn3 = EOS013*zt & 384 & + EOS103*zs+EOS003 385 ! 386 zn2 = (EOS022*zt & 387 & + EOS112*zs+EOS012)*zt & 388 & + (EOS202*zs+EOS102)*zs+EOS002 389 ! 390 zn1 = (((EOS041*zt & 391 & + EOS131*zs+EOS031)*zt & 392 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 393 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 394 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 395 ! 396 zn0_sto(jsmp) = (((((EOS060*zt & 397 & + EOS150*zs+EOS050)*zt & 398 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 399 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 400 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 401 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 402 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 403 ! 404 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 405 END DO 406 ! 407 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 408 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 409 DO jsmp = 1, nn_sto_eos*2 410 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 411 ! 412 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 413 END DO 414 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 415 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 416 END DO 417 END DO 418 END DO 402 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 403 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 404 END_3D 419 405 DEALLOCATE(zn0_sto,zn_sto,zsign) 420 406 ! Non-stochastic equation of state 421 407 ELSE 422 DO jk = 1, jpkm1 423 DO jj = 1, jpj 424 DO ji = 1, jpi 425 ! 426 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 427 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 428 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 429 ztm = tmask(ji,jj,jk) ! tmask 430 ! 431 zn3 = EOS013*zt & 432 & + EOS103*zs+EOS003 433 ! 434 zn2 = (EOS022*zt & 435 & + EOS112*zs+EOS012)*zt & 436 & + (EOS202*zs+EOS102)*zs+EOS002 437 ! 438 zn1 = (((EOS041*zt & 439 & + EOS131*zs+EOS031)*zt & 440 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 441 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 442 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 443 ! 444 zn0 = (((((EOS060*zt & 445 & + EOS150*zs+EOS050)*zt & 446 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 447 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 448 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 449 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 450 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 451 ! 452 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 453 ! 454 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 455 ! 456 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 457 END DO 458 END DO 459 END DO 460 ENDIF 461 462 CASE( np_seos ) !== simplified EOS ==! 463 ! 464 DO jk = 1, jpkm1 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 zt = pts (ji,jj,jk,jp_tem) - 10._wp 468 zs = pts (ji,jj,jk,jp_sal) - 35._wp 469 zh = pdep (ji,jj,jk) 470 ztm = tmask(ji,jj,jk) 471 ! ! potential density referenced at the surface 472 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 473 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 474 & - rn_nu * zt * zs 475 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 476 ! ! density anomaly (masked) 477 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 478 prd(ji,jj,jk) = zn * r1_rho0 * ztm 479 ! 480 END DO 481 END DO 482 END DO 483 ! 484 CASE( np_leos ) !== linear ISOMIP EOS ==! 485 ! 486 DO jk = 1, jpkm1 487 DO jj = 1, jpj 488 DO ji = 1, jpi 489 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 490 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 491 zh = pdep (ji,jj,jk) 492 ztm = tmask(ji,jj,jk) 493 ! ! potential density referenced at the surface 494 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 495 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 496 ! ! density anomaly (masked) 497 prd(ji,jj,jk) = zn * r1_rho0 * ztm 498 ! 499 END DO 500 END DO 501 END DO 502 ! 503 END SELECT 504 ! 505 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 506 ! 507 IF( ln_timing ) CALL timing_stop('eos-pot') 508 ! 509 END SUBROUTINE eos_insitu_pot 510 511 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !!---------------------------------------------------------------------- 514 !! *** ROUTINE eos_insitu_2d *** 515 !! 516 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 517 !! potential temperature and salinity using an equation of state 518 !! selected in the nameos namelist. * 2D field case 519 !! 520 !! ** Action : - prd , the in situ density (no units) (unmasked) 521 !! 522 !!---------------------------------------------------------------------- 523 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 524 ! ! 2 : salinity [psu] 525 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 526 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 527 ! 528 INTEGER :: ji, jj, jk ! dummy loop indices 529 REAL(wp) :: zt , zh , zs ! local scalars 530 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 531 !!---------------------------------------------------------------------- 532 ! 533 IF( ln_timing ) CALL timing_start('eos2d') 534 ! 535 prd(:,:) = 0._wp 536 ! 537 SELECT CASE( neos ) 538 ! 539 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 540 ! 541 DO jj = 1, jpjm1 542 DO ji = 1, fs_jpim1 ! vector opt. 543 ! 544 zh = pdep(ji,jj) * r1_Z0 ! depth 545 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 546 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 408 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 409 ! 410 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 411 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 412 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 413 ztm = tmask(ji,jj,jk) ! tmask 547 414 ! 548 415 zn3 = EOS013*zt & … … 569 436 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 570 437 ! 571 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 572 ! 573 END DO 574 END DO 575 ! 576 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 577 ! 438 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 439 ! 440 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 441 END_3D 442 ENDIF 443 578 444 CASE( np_seos ) !== simplified EOS ==! 579 445 ! 580 DO jj = 1, jpjm1 581 DO ji = 1, fs_jpim1 ! vector opt. 582 ! 583 zt = pts (ji,jj,jp_tem) - 10._wp 584 zs = pts (ji,jj,jp_sal) - 35._wp 585 zh = pdep (ji,jj) ! depth at the partial step level 586 ! 587 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 588 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 589 & - rn_nu * zt * zs 590 ! 591 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 592 ! 593 END DO 594 END DO 595 ! 596 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 446 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 447 zt = pts (ji,jj,jk,jp_tem) - 10._wp 448 zs = pts (ji,jj,jk,jp_sal) - 35._wp 449 zh = pdep (ji,jj,jk) 450 ztm = tmask(ji,jj,jk) 451 ! ! potential density referenced at the surface 452 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 453 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 454 & - rn_nu * zt * zs 455 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 456 ! ! density anomaly (masked) 457 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 458 prd(ji,jj,jk) = zn * r1_rho0 * ztm 459 ! 460 END_3D 461 ! 462 CASE( np_leos ) !== linear ISOMIP EOS ==! 463 ! 464 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 465 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 466 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 467 zh = pdep (ji,jj,jk) 468 ztm = tmask(ji,jj,jk) 469 ! ! potential density referenced at the surface 470 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 471 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 472 ! ! density anomaly (masked) 473 prd(ji,jj,jk) = zn * r1_rho0 * ztm 474 ! 475 END_3D 476 ! 477 END SELECT 478 ! 479 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 480 ! 481 IF( ln_timing ) CALL timing_stop('eos-pot') 482 ! 483 END SUBROUTINE eos_insitu_pot 484 485 486 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 487 !!---------------------------------------------------------------------- 488 !! *** ROUTINE eos_insitu_2d *** 489 !! 490 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 491 !! potential temperature and salinity using an equation of state 492 !! selected in the nameos namelist. * 2D field case 493 !! 494 !! ** Action : - prd , the in situ density (no units) (unmasked) 495 !! 496 !!---------------------------------------------------------------------- 497 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 498 ! ! 2 : salinity [psu] 499 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 500 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 501 ! 502 INTEGER :: ji, jj, jk ! dummy loop indices 503 REAL(wp) :: zt , zh , zs ! local scalars 504 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 505 !!---------------------------------------------------------------------- 506 ! 507 IF( ln_timing ) CALL timing_start('eos2d') 508 ! 509 prd(:,:) = 0._wp 510 ! 511 SELECT CASE( neos ) 512 ! 513 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 514 ! 515 DO_2D( 1, 1, 1, 1 ) 516 ! 517 zh = pdep(ji,jj) * r1_Z0 ! depth 518 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 519 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 520 ! 521 zn3 = EOS013*zt & 522 & + EOS103*zs+EOS003 523 ! 524 zn2 = (EOS022*zt & 525 & + EOS112*zs+EOS012)*zt & 526 & + (EOS202*zs+EOS102)*zs+EOS002 527 ! 528 zn1 = (((EOS041*zt & 529 & + EOS131*zs+EOS031)*zt & 530 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 531 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 532 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 533 ! 534 zn0 = (((((EOS060*zt & 535 & + EOS150*zs+EOS050)*zt & 536 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 537 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 538 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 539 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 540 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 541 ! 542 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 543 ! 544 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 545 ! 546 END_2D 547 ! 548 CASE( np_seos ) !== simplified EOS ==! 549 ! 550 DO_2D( 1, 1, 1, 1 ) 551 ! 552 zt = pts (ji,jj,jp_tem) - 10._wp 553 zs = pts (ji,jj,jp_sal) - 35._wp 554 zh = pdep (ji,jj) ! depth at the partial step level 555 ! 556 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 557 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 558 & - rn_nu * zt * zs 559 ! 560 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 561 ! 562 END_2D 597 563 ! 598 564 CASE( np_leos ) !== ISOMIP EOS ==! 599 565 ! 600 DO jj = 1, jpjm1 601 DO ji = 1, fs_jpim1 ! vector opt. 602 ! 603 zt = pts (ji,jj,jp_tem) - (-1._wp) 604 zs = pts (ji,jj,jp_sal) - 34.2_wp 605 zh = pdep (ji,jj) ! depth at the partial step level 606 ! 607 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 608 ! 609 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 610 ! 611 END DO 612 END DO 613 ! 614 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 566 DO_2D( 1, 1, 1, 1 ) 567 ! 568 zt = pts (ji,jj,jp_tem) - (-1._wp) 569 zs = pts (ji,jj,jp_sal) - 34.2_wp 570 zh = pdep (ji,jj) ! depth at the partial step level 571 ! 572 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 573 ! 574 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 575 ! 576 END_2D 577 ! 615 578 ! 616 579 END SELECT 617 580 ! 618 IF( ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )581 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 619 582 ! 620 583 IF( ln_timing ) CALL timing_stop('eos2d') … … 648 611 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 649 612 ! 650 DO jk = 1, jpkm1 651 DO jj = 1, jpj 652 DO ji = 1, jpi 653 ! 654 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 655 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 656 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 657 ztm = tmask(ji,jj,jk) ! tmask 658 ! 659 ! alpha 660 zn3 = ALP003 661 ! 662 zn2 = ALP012*zt + ALP102*zs+ALP002 663 ! 664 zn1 = ((ALP031*zt & 665 & + ALP121*zs+ALP021)*zt & 666 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 667 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 668 ! 669 zn0 = ((((ALP050*zt & 670 & + ALP140*zs+ALP040)*zt & 671 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 672 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 673 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 674 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 675 ! 676 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 677 ! 678 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 679 ! 680 ! beta 681 zn3 = BET003 682 ! 683 zn2 = BET012*zt + BET102*zs+BET002 684 ! 685 zn1 = ((BET031*zt & 686 & + BET121*zs+BET021)*zt & 687 & + (BET211*zs+BET111)*zs+BET011)*zt & 688 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 689 ! 690 zn0 = ((((BET050*zt & 691 & + BET140*zs+BET040)*zt & 692 & + (BET230*zs+BET130)*zs+BET030)*zt & 693 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 694 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 695 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 696 ! 697 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 698 ! 699 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 700 ! 701 END DO 702 END DO 703 END DO 613 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 614 ! 615 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 616 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 617 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 618 ztm = tmask(ji,jj,jk) ! tmask 619 ! 620 ! alpha 621 zn3 = ALP003 622 ! 623 zn2 = ALP012*zt + ALP102*zs+ALP002 624 ! 625 zn1 = ((ALP031*zt & 626 & + ALP121*zs+ALP021)*zt & 627 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 628 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 629 ! 630 zn0 = ((((ALP050*zt & 631 & + ALP140*zs+ALP040)*zt & 632 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 633 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 634 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 635 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 636 ! 637 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 638 ! 639 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 640 ! 641 ! beta 642 zn3 = BET003 643 ! 644 zn2 = BET012*zt + BET102*zs+BET002 645 ! 646 zn1 = ((BET031*zt & 647 & + BET121*zs+BET021)*zt & 648 & + (BET211*zs+BET111)*zs+BET011)*zt & 649 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 650 ! 651 zn0 = ((((BET050*zt & 652 & + BET140*zs+BET040)*zt & 653 & + (BET230*zs+BET130)*zs+BET030)*zt & 654 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 655 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 656 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 657 ! 658 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 659 ! 660 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 661 ! 662 END_3D 704 663 ! 705 664 CASE( np_seos ) !== simplified EOS ==! 706 665 ! 707 DO jk = 1, jpkm1 708 DO jj = 1, jpj 709 DO ji = 1, jpi 710 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 711 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 712 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 713 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 714 ! 715 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 716 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 717 ! 718 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 719 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 720 ! 721 END DO 722 END DO 723 END DO 666 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 667 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 668 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 669 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 670 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 671 ! 672 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 673 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 674 ! 675 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 676 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 677 ! 678 END_3D 724 679 ! 725 680 CASE( np_leos ) !== linear ISOMIP EOS ==! 726 681 ! 727 DO jk = 1, jpkm1 728 DO jj = 1, jpj 729 DO ji = 1, jpi 730 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 731 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 732 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 733 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 734 ! 735 zn = rn_a0 * rho0 736 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 737 ! 738 zn = rn_b0 * rho0 739 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 740 ! 741 END DO 742 END DO 743 END DO 682 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 683 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 684 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 685 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 686 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 687 ! 688 zn = rn_a0 * rho0 689 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 690 ! 691 zn = rn_b0 * rho0 692 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 693 ! 694 END_3D 744 695 ! 745 696 CASE DEFAULT … … 749 700 END SELECT 750 701 ! 751 IF( ln_ctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &752 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )702 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 703 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 753 704 ! 754 705 IF( ln_timing ) CALL timing_stop('rab_3d') … … 783 734 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 784 735 ! 785 DO jj = 1, jpjm1 786 DO ji = 1, fs_jpim1 ! vector opt. 787 ! 788 zh = pdep(ji,jj) * r1_Z0 ! depth 789 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 790 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 791 ! 792 ! alpha 793 zn3 = ALP003 794 ! 795 zn2 = ALP012*zt + ALP102*zs+ALP002 796 ! 797 zn1 = ((ALP031*zt & 798 & + ALP121*zs+ALP021)*zt & 799 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 800 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 801 ! 802 zn0 = ((((ALP050*zt & 803 & + ALP140*zs+ALP040)*zt & 804 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 805 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 806 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 807 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 808 ! 809 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 810 ! 811 pab(ji,jj,jp_tem) = zn * r1_rho0 812 ! 813 ! beta 814 zn3 = BET003 815 ! 816 zn2 = BET012*zt + BET102*zs+BET002 817 ! 818 zn1 = ((BET031*zt & 819 & + BET121*zs+BET021)*zt & 820 & + (BET211*zs+BET111)*zs+BET011)*zt & 821 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 822 ! 823 zn0 = ((((BET050*zt & 824 & + BET140*zs+BET040)*zt & 825 & + (BET230*zs+BET130)*zs+BET030)*zt & 826 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 827 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 828 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 829 ! 830 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 831 ! 832 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 833 ! 834 ! 835 END DO 836 END DO 837 ! ! Lateral boundary conditions 838 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 736 DO_2D( 1, 1, 1, 1 ) 737 ! 738 zh = pdep(ji,jj) * r1_Z0 ! depth 739 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 740 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 741 ! 742 ! alpha 743 zn3 = ALP003 744 ! 745 zn2 = ALP012*zt + ALP102*zs+ALP002 746 ! 747 zn1 = ((ALP031*zt & 748 & + ALP121*zs+ALP021)*zt & 749 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 750 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 751 ! 752 zn0 = ((((ALP050*zt & 753 & + ALP140*zs+ALP040)*zt & 754 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 755 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 756 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 757 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 758 ! 759 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 760 ! 761 pab(ji,jj,jp_tem) = zn * r1_rho0 762 ! 763 ! beta 764 zn3 = BET003 765 ! 766 zn2 = BET012*zt + BET102*zs+BET002 767 ! 768 zn1 = ((BET031*zt & 769 & + BET121*zs+BET021)*zt & 770 & + (BET211*zs+BET111)*zs+BET011)*zt & 771 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 772 ! 773 zn0 = ((((BET050*zt & 774 & + BET140*zs+BET040)*zt & 775 & + (BET230*zs+BET130)*zs+BET030)*zt & 776 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 777 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 778 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 779 ! 780 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 781 ! 782 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 783 ! 784 ! 785 END_2D 839 786 ! 840 787 CASE( np_seos ) !== simplified EOS ==! 841 788 ! 842 DO jj = 1, jpjm1 843 DO ji = 1, fs_jpim1 ! vector opt. 844 ! 845 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 846 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 847 zh = pdep (ji,jj) ! depth at the partial step level 848 ! 849 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 850 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 851 ! 852 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 853 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 854 ! 855 END DO 856 END DO 857 ! ! Lateral boundary conditions 858 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 789 DO_2D( 1, 1, 1, 1 ) 790 ! 791 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 792 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 793 zh = pdep (ji,jj) ! depth at the partial step level 794 ! 795 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 796 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 797 ! 798 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 799 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 800 ! 801 END_2D 859 802 ! 860 803 CASE( np_leos ) !== linear ISOMIP EOS ==! 861 804 ! 862 DO jj = 1, jpjm1 863 DO ji = 1, fs_jpim1 ! vector opt. 864 ! 865 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 866 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 867 zh = pdep (ji,jj) ! depth at the partial step level 868 ! 869 zn = rn_a0 * rho0 870 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 871 ! 872 zn = rn_b0 * rho0 873 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 874 ! 875 END DO 876 END DO 877 ! 878 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) ! Lateral boundary conditions 805 DO_2D( 1, 1, 1, 1 ) 806 ! 807 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 808 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 809 zh = pdep (ji,jj) ! depth at the partial step level 810 ! 811 zn = rn_a0 * rho0 812 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 813 ! 814 zn = rn_b0 * rho0 815 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 816 ! 817 END_2D 879 818 ! 880 819 CASE DEFAULT … … 884 823 END SELECT 885 824 ! 886 IF( ln_ctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &887 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )825 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 826 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 888 827 ! 889 828 IF( ln_timing ) CALL timing_stop('rab_2d') … … 1026 965 IF( ln_timing ) CALL timing_start('bn2') 1027 966 ! 1028 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 1029 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 1030 DO ji = 1, jpi 1031 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 1032 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 1033 ! 1034 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 1035 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 1036 ! 1037 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 1038 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 1039 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 1040 END DO 1041 END DO 1042 END DO 1043 ! 1044 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 967 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 968 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 969 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 970 ! 971 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 972 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 973 ! 974 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 975 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 976 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 977 END_3D 978 ! 979 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 1045 980 ! 1046 981 IF( ln_timing ) CALL timing_stop('bn2') … … 1078 1013 z1_T0 = 1._wp/40._wp 1079 1014 ! 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 ! 1083 zt = ctmp (ji,jj) * z1_T0 1084 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1085 ztm = tmask(ji,jj,1) 1086 ! 1087 zn = ((((-2.1385727895e-01_wp*zt & 1088 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1089 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1090 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1091 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1092 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1093 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1094 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1095 ! 1096 zd = (2.0035003456_wp*zt & 1097 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1098 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1099 ! 1100 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1101 ! 1102 END DO 1103 END DO 1015 DO_2D( 1, 1, 1, 1 ) 1016 ! 1017 zt = ctmp (ji,jj) * z1_T0 1018 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1019 ztm = tmask(ji,jj,1) 1020 ! 1021 zn = ((((-2.1385727895e-01_wp*zt & 1022 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1023 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1024 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1025 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1026 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1027 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1028 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1029 ! 1030 zd = (2.0035003456_wp*zt & 1031 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1032 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1033 ! 1034 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1035 ! 1036 END_2D 1104 1037 ! 1105 1038 IF( ln_timing ) CALL timing_stop('eos_pt_from_ct') … … 1133 1066 ! 1134 1067 z1_S0 = 1._wp / 35.16504_wp 1135 DO jj = 1, jpj 1136 DO ji = 1, jpi 1137 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1138 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1139 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1140 END DO 1141 END DO 1068 DO_2D( 1, 1, 1, 1 ) 1069 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1070 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1071 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1072 END_2D 1142 1073 ptf(:,:) = ptf(:,:) * psal(:,:) 1143 1074 ! 1144 1075 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1145 1076 ! 1146 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1077 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1147 1078 ! 1148 1079 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & … … 1190 1121 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1191 1122 ! 1192 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1123 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1193 1124 ! 1194 1125 ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) & … … 1242 1173 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1243 1174 ! 1244 DO jk = 1, jpkm1 1245 DO jj = 1, jpj 1246 DO ji = 1, jpi 1247 ! 1248 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1249 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1250 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1251 ztm = tmask(ji,jj,jk) ! tmask 1252 ! 1253 ! potential energy non-linear anomaly 1254 zn2 = (PEN012)*zt & 1255 & + PEN102*zs+PEN002 1256 ! 1257 zn1 = ((PEN021)*zt & 1258 & + PEN111*zs+PEN011)*zt & 1259 & + (PEN201*zs+PEN101)*zs+PEN001 1260 ! 1261 zn0 = ((((PEN040)*zt & 1262 & + PEN130*zs+PEN030)*zt & 1263 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1264 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1265 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1266 ! 1267 zn = ( zn2 * zh + zn1 ) * zh + zn0 1268 ! 1269 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1270 ! 1271 ! alphaPE non-linear anomaly 1272 zn2 = APE002 1273 ! 1274 zn1 = (APE011)*zt & 1275 & + APE101*zs+APE001 1276 ! 1277 zn0 = (((APE030)*zt & 1278 & + APE120*zs+APE020)*zt & 1279 & + (APE210*zs+APE110)*zs+APE010)*zt & 1280 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1281 ! 1282 zn = ( zn2 * zh + zn1 ) * zh + zn0 1283 ! 1284 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1285 ! 1286 ! betaPE non-linear anomaly 1287 zn2 = BPE002 1288 ! 1289 zn1 = (BPE011)*zt & 1290 & + BPE101*zs+BPE001 1291 ! 1292 zn0 = (((BPE030)*zt & 1293 & + BPE120*zs+BPE020)*zt & 1294 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1295 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1296 ! 1297 zn = ( zn2 * zh + zn1 ) * zh + zn0 1298 ! 1299 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1300 ! 1301 END DO 1302 END DO 1303 END DO 1175 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1176 ! 1177 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1178 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1179 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1180 ztm = tmask(ji,jj,jk) ! tmask 1181 ! 1182 ! potential energy non-linear anomaly 1183 zn2 = (PEN012)*zt & 1184 & + PEN102*zs+PEN002 1185 ! 1186 zn1 = ((PEN021)*zt & 1187 & + PEN111*zs+PEN011)*zt & 1188 & + (PEN201*zs+PEN101)*zs+PEN001 1189 ! 1190 zn0 = ((((PEN040)*zt & 1191 & + PEN130*zs+PEN030)*zt & 1192 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1193 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1194 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1195 ! 1196 zn = ( zn2 * zh + zn1 ) * zh + zn0 1197 ! 1198 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1199 ! 1200 ! alphaPE non-linear anomaly 1201 zn2 = APE002 1202 ! 1203 zn1 = (APE011)*zt & 1204 & + APE101*zs+APE001 1205 ! 1206 zn0 = (((APE030)*zt & 1207 & + APE120*zs+APE020)*zt & 1208 & + (APE210*zs+APE110)*zs+APE010)*zt & 1209 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1210 ! 1211 zn = ( zn2 * zh + zn1 ) * zh + zn0 1212 ! 1213 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1214 ! 1215 ! betaPE non-linear anomaly 1216 zn2 = BPE002 1217 ! 1218 zn1 = (BPE011)*zt & 1219 & + BPE101*zs+BPE001 1220 ! 1221 zn0 = (((BPE030)*zt & 1222 & + BPE120*zs+BPE020)*zt & 1223 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1224 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1225 ! 1226 zn = ( zn2 * zh + zn1 ) * zh + zn0 1227 ! 1228 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1229 ! 1230 END_3D 1304 1231 ! 1305 1232 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1306 1233 ! 1307 DO jk = 1, jpkm1 1308 DO jj = 1, jpj 1309 DO ji = 1, jpi 1310 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1311 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1312 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1313 ztm = tmask(ji,jj,jk) ! tmask 1314 zn = 0.5_wp * zh * r1_rho0 * ztm 1315 ! ! Potential Energy 1316 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1317 ! ! alphaPE 1318 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1319 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1320 ! 1321 END DO 1322 END DO 1323 END DO 1234 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1235 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1236 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1237 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1238 ztm = tmask(ji,jj,jk) ! tmask 1239 zn = 0.5_wp * zh * r1_rho0 * ztm 1240 ! ! Potential Energy 1241 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1242 ! ! alphaPE 1243 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1244 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1245 ! 1246 END_3D 1324 1247 ! 1325 1248 CASE( np_leos ) !== linear ISOMIP EOS ==! 1326 1249 ! 1327 DO jk = 1, jpkm1 1328 DO jj = 1, jpj 1329 DO ji = 1, jpi 1330 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1331 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1332 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1333 ztm = tmask(ji,jj,jk) ! tmask 1334 zn = 0.5_wp * zh * r1_rho0 * ztm 1335 ! ! Potential Energy 1336 ppen(ji,jj,jk) = 0. 1337 ! ! alphaPE 1338 pab_pe(ji,jj,jk,jp_tem) = 0. 1339 pab_pe(ji,jj,jk,jp_sal) = 0. 1340 ! 1341 END DO 1342 END DO 1343 END DO 1250 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1251 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1252 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1253 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1254 ztm = tmask(ji,jj,jk) ! tmask 1255 zn = 0.5_wp * zh * r1_rho0 * ztm 1256 ! ! Potential Energy 1257 ppen(ji,jj,jk) = 0. 1258 ! ! alphaPE 1259 pab_pe(ji,jj,jk,jp_tem) = 0. 1260 pab_pe(ji,jj,jk,jp_sal) = 0. 1261 ! 1262 END_3D 1344 1263 ! 1345 1264 CASE DEFAULT … … 1365 1284 INTEGER :: ioptio ! local integer 1366 1285 !! 1367 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS , ln_LEOS, & 1368 & rn_a0 , rn_b0 , rn_lambda1, rn_mu1 , & 1369 & rn_lambda2, rn_mu2 , rn_nu 1370 !!---------------------------------------------------------------------- 1371 ! 1372 REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state 1286 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, & 1287 & rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu 1288 !!---------------------------------------------------------------------- 1289 ! 1373 1290 READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 1374 1291 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist' ) 1375 1292 ! 1376 REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state1377 1293 READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 1378 1294 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist' ) -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/isfcavgam.F90
r12077 r13540 91 91 pgs(:,:) = rn_gammas0 92 92 CASE ( 'vel' ) ! gamma is proportional to u* 93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r _ke0_top, pgt, pgs )93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, rn_vtide**2, pgt, pgs ) 94 94 CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r _ke0_top, pqoce, pqfwf, pgt, pgs )95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, rn_vtide**2, pqoce, pqfwf, pgt, pgs ) 96 96 CASE DEFAULT 97 97 CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/isfstp.F90
r12077 r13540 250 250 IF ( l_isfoasis .AND. ln_isf ) THEN 251 251 ! 252 CALL ctl_stop( ' ln_ctl and ice shelf not tested' )252 CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' ) 253 253 ! 254 254 ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation … … 291 291 !!---------------------------------------------------------------------- 292 292 ! 293 REWIND( numnam_ref ) ! Namelist namsbc_rnf in reference namelist : Runoffs294 293 READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 295 294 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' ) 296 295 ! 297 REWIND( numnam_cfg ) ! Namelist namsbc_rnf in configuration namelist : Runoffs298 296 READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 299 297 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' ) -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/istate.F90
r12353 r13540 41 41 PUBLIC istate_init ! routine called by step.F90 42 42 43 !! * Substitutions 44 # include "do_loop_substitute.h90" 43 45 !!---------------------------------------------------------------------- 44 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 76 78 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 77 ts (:,:,:,:,Kaa) = 0._wp! set one for all to 0 at level jpk79 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 78 80 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 79 81 #if defined key_agrif … … 90 92 ! ! --------------- 91 93 numror = 0 ! define numror = 0 -> no restart file to read 92 neuler = 0! Set time-step indicator at nit000 (euler forward)94 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 93 95 CALL day_init ! model calendar (using both namelist and restart infos) 94 96 ! ! Initialization of ocean to zero … … 103 105 ! Apply minimum wetdepth criterion 104 106 ! 105 DO jj = 1,jpj 106 DO ji = 1,jpi 107 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 108 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 109 ENDIF 110 END DO 111 END DO 107 DO_2D( 1, 1, 1, 1 ) 108 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 109 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 110 ENDIF 111 END_2D 112 112 ENDIF 113 113 uu (:,:,:,Kbb) = 0._wp … … 159 159 ! 160 160 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 161 DO jk = 1, jpkm1 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 165 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 166 ! 167 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 168 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 169 END DO 170 END DO 171 END DO 161 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 162 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 163 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 164 ! 165 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 166 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 167 END_3D 172 168 ! 173 169 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/sbcfwb.F90
r12511 r13540 95 95 snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass 96 96 snwice_mass (:,:) = 0.e0 97 snwice_fmass (:,:) = 0.e0 97 98 #endif 98 99 ! … … 151 152 ENDIF 152 153 ! ! Update fwfold if new year start 153 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!!154 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 154 155 IF( MOD( kt, ikty ) == 0 ) THEN 155 156 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow … … 211 212 erp(:,:) = erp(:,:) + zerp_cor(:,:) 212 213 ! 213 IF( nprint == 1 .AND.lwp ) THEN ! control print214 IF( lwp ) THEN ! control print 214 215 IF( z_fwf < 0._wp ) THEN 215 216 WRITE(numout,*)' z_fwf < 0' -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP+/MY_SRC/tradmp.F90
r12353 r13540 51 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 52 52 53 !! * Substitutions 54 # include "do_loop_substitute.h90" 53 55 !!---------------------------------------------------------------------- 54 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 112 CASE( 0 ) !* newtonian damping throughout the water column *! 111 113 DO jn = 1, jpts 112 DO jk = 1, jpkm1 113 DO jj = 2, jpjm1 114 DO ji = fs_2, fs_jpim1 ! vector opt. 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END DO 118 END DO 119 END DO 114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END_3D 120 118 END DO 121 119 ! 122 120 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 123 DO jk = 1, jpkm1 124 DO jj = 2, jpjm1 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 127 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 129 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 131 ENDIF 132 END DO 133 END DO 134 END DO 121 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 122 IF( avt(ji,jj,jk) <= avt_c ) THEN 123 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 124 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 125 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 126 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 127 ENDIF 128 END_3D 135 129 ! 136 130 CASE ( 2 ) !* no damping in the mixed layer *! 137 DO jk = 1, jpkm1 138 DO jj = 2, jpjm1 139 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 141 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 143 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 145 ENDIF 146 END DO 147 END DO 148 END DO 131 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 132 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 133 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 134 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 135 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 136 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 137 ENDIF 138 END_3D 149 139 ! 150 140 END SELECT … … 157 147 ENDIF 158 148 ! ! Control print 159 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, &160 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )149 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, & 150 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 151 ! 162 152 IF( ln_timing ) CALL timing_stop('tra_dmp') … … 178 168 !!---------------------------------------------------------------------- 179 169 ! 180 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation181 170 READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 182 171 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 183 172 ! 184 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation185 173 READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 186 174 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) … … 220 208 ! ! Read in mask from file 221 209 CALL iom_open ( cn_resto, imask) 222 CALL iom_get ( imask, jpdom_auto glo, 'resto', resto )210 CALL iom_get ( imask, jpdom_auto, 'resto', resto ) 223 211 CALL iom_close( imask ) 224 212 ENDIF -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP/EXPREF/namelist_cfg
r12511 r13540 227 227 !! !! 228 228 !! namdrg top/bottom drag coefficient (default: NO selection) 229 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)230 !! namdrg_bot bottom friction (ln_ OFF=F)229 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 230 !! namdrg_bot bottom friction (ln_drg_OFF=F) 231 231 !! nambbc bottom temperature boundary condition (default: OFF) 232 232 !! nambbl bottom boundary layer scheme (default: OFF) … … 236 236 &namdrg ! top/bottom drag coefficient (default: NO selection) 237 237 !----------------------------------------------------------------------- 238 ln_ OFF = .false.! free-slip : Cd = 0 (F => fill namdrg_bot238 ln_drg_OFF = .false. ! free-slip : Cd = 0 (F => fill namdrg_bot 239 239 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 240 240 ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U| … … 244 244 / 245 245 !----------------------------------------------------------------------- 246 &namdrg_top ! TOP friction (ln_ OFF =F & ln_isfcav=T)246 &namdrg_top ! TOP friction (ln_drg_OFF =F & ln_isfcav=T) 247 247 !----------------------------------------------------------------------- 248 248 rn_Cd0 = 2.5e-3 ! drag coefficient [-] … … 255 255 / 256 256 !----------------------------------------------------------------------- 257 &namdrg_bot ! BOTTOM friction (ln_ OFF =F)257 &namdrg_bot ! BOTTOM friction (ln_drg_OFF =F) 258 258 !----------------------------------------------------------------------- 259 259 rn_Cd0 = 1.e-3 ! drag coefficient [-] -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
r10074 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh for ISOMIP configuration 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain16 USE dom_oce 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants … … 27 27 PUBLIC usr_def_hgr ! called by domhgr.F90 28 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 29 31 !!---------------------------------------------------------------------- 30 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 ! 76 78 ! !== grid point position ==! (in degrees) 77 DO jj = 1, jpj 78 DO ji = 1, jpi ! longitude (west coast at lon=0°) 79 plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 80 plamu(ji,jj) = rn_e1deg * ( REAL( ji-1 + nimpp-1 , wp ) ) 81 plamv(ji,jj) = plamt(ji,jj) 82 plamf(ji,jj) = plamu(ji,jj) 83 ! ! latitude (south coast at lat= 81°) 84 pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) - 80._wp 85 pphiu(ji,jj) = pphit(ji,jj) 86 pphiv(ji,jj) = rn_e2deg * ( REAL( jj-1 + njmpp-1 , wp ) ) - 80_wp 87 pphif(ji,jj) = pphiv(ji,jj) 88 END DO 89 END DO 79 DO_2D( 1, 1, 1, 1 ) 80 ! ! longitude (west coast at lon=0°) 81 plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp ) ) 82 plamu(ji,jj) = rn_e1deg * ( REAL( mig0_oldcmp(ji)-1 , wp ) ) 83 plamv(ji,jj) = plamt(ji,jj) 84 plamf(ji,jj) = plamu(ji,jj) 85 ! ! latitude (south coast at lat= 81°) 86 pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp ) ) - 80._wp 87 pphiu(ji,jj) = pphit(ji,jj) 88 pphiv(ji,jj) = rn_e2deg * ( REAL( mjg0_oldcmp(jj)-1 , wp ) ) - 80_wp 89 pphif(ji,jj) = pphiv(ji,jj) 90 END_2D 90 91 ! 91 92 ! !== Horizontal scale factors ==! (in meters) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 ! ! e1 (zonal) 95 pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 96 pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 97 pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 98 pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 99 ! ! e2 (meridional) 100 pe2t(ji,jj) = ra * rad * rn_e2deg 101 pe2u(ji,jj) = ra * rad * rn_e2deg 102 pe2v(ji,jj) = ra * rad * rn_e2deg 103 pe2f(ji,jj) = ra * rad * rn_e2deg 104 END DO 105 END DO 93 DO_2D( 1, 1, 1, 1 ) 94 ! ! e1 (zonal) 95 pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 96 pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 97 pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 98 pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 99 ! ! e2 (meridional) 100 pe2t(ji,jj) = ra * rad * rn_e2deg 101 pe2u(ji,jj) = ra * rad * rn_e2deg 102 pe2v(ji,jj) = ra * rad * rn_e2deg 103 pe2f(ji,jj) = ra * rad * rn_e2deg 104 END_2D 106 105 ! ! NO reduction of grid size in some straits 107 106 ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_ghr routine -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP/MY_SRC/usrdef_nam.F90
r12377 r13540 15 15 !! usr_def_hgr : initialize the horizontal mesh 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain18 17 USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate 19 18 USE par_oce ! ocean space and time domain … … 95 94 WRITE(numout,*) ' vertical resolution rn_e3 = ', rn_e3 , ' meters' 96 95 WRITE(numout,*) ' ISOMIP domain = 15° x 10° x 900 m' 97 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi98 WRITE(numout,*) ' jpjglo = ', kpj96 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 97 WRITE(numout,*) ' Nj0glo = ', kpj 99 98 WRITE(numout,*) ' jpkglo = ', kpk 100 99 WRITE(numout,*) ' ' -
NEMO/branches/2020/r12377_ticket2386/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
r12377 r13540 16 16 !!--------------------------------------------------------------------- 17 17 USE oce ! ocean variables 18 USE dom_oce , ONLY: mj0 , mj1 , nimpp , njmpp! ocean space and time domain19 USE dom_oce , ONLY: glamt , gphit 18 USE dom_oce , ONLY: mj0 , mj1 ! ocean space and time domain 19 USE dom_oce , ONLY: glamt , gphit ! ocean space and time domain 20 20 USE usrdef_nam ! User defined : namelist variables 21 21 ! … … 30 30 PUBLIC usr_def_zgr ! called by domzgr.F90 31 31 32 !! * Substitutions 33 # include "do_loop_substitute.h90" 32 34 !!---------------------------------------------------------------------- 33 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 65 67 REAL(wp), DIMENSION(jpi,jpj) :: zht , zhu ! bottom depth 66 68 REAL(wp), DIMENSION(jpi,jpj) :: zhisf, zhisfu ! top depth 67 REAL(wp), DIMENSION(jpi,jpj) :: zmsk68 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2d workspace69 69 !!---------------------------------------------------------------------- 70 70 ! … … 85 85 ! !== isfdraft ==! 86 86 ! 87 ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=088 z2d(:,:) = 1._wp ! surface ocean is the 1st level89 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! closed basin since jperio = 0 (see userdef_nam.F90)90 zmsk(:,:) = NINT( z2d(:,:) )91 !92 !93 87 zht (:,:) = rbathy 94 88 zhisf(:,:) = 200._wp 95 ij0 = 1 ; ij1 = 4089 ij0 = 1 ; ij1 = 40+nn_hls 96 90 DO jj = mj0(ij0), mj1(ij1) 97 91 zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 98 92 END DO 99 zhisf(:,:) = zhisf(:,:) * zmsk(:,:)100 93 ! 101 94 CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! Reference z-coordinate system … … 132 125 pe3vw(:,:,jk) = pe3w_1d (jk) 133 126 END DO 134 DO jj = 1, jpj ! top scale factors and depth at T- and W-points 135 DO ji = 1, jpi 136 ik = k_top(ji,jj) 137 IF ( ik > 2 ) THEN 138 ! pdeptw at the interface 139 pdepw(ji,jj,ik ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 140 ! e3t in both side of the interface 141 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 142 ! pdept in both side of the interface (from previous e3t) 143 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 144 pdept(ji,jj,ik-1) = pdepw(ji,jj,ik ) - pe3t (ji,jj,ik ) * 0.5_wp 145 ! pe3w on both side of the interface 146 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik ) 147 pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1) 148 ! e3t into the ice shelf 149 pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik ) - pdepw(ji,jj,ik-1) 150 pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 151 END IF 152 END DO 153 END DO 154 DO jj = 1, jpj ! bottom scale factors and depth at T- and W-points 155 DO ji = 1, jpi 156 ik = k_bot(ji,jj) 157 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 127 ! top scale factors and depth at T- and W-points 128 DO_2D( 1, 1, 1, 1 ) 129 ik = k_top(ji,jj) 130 IF ( ik > 2 ) THEN 131 ! pdeptw at the interface 132 pdepw(ji,jj,ik ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 133 ! e3t in both side of the interface 158 134 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 159 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 160 ! 135 ! pdept in both side of the interface (from previous e3t) 161 136 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 162 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 163 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 164 END DO 165 END DO 137 pdept(ji,jj,ik-1) = pdepw(ji,jj,ik ) - pe3t (ji,jj,ik ) * 0.5_wp 138 ! pe3w on both side of the interface 139 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik ) 140 pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1) 141 ! e3t into the ice shelf 142 pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik ) - pdepw(ji,jj,ik-1) 143 pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 144 END IF 145 END_2D 146 ! bottom scale factors and depth at T- and W-points 147 DO_2D( 1, 1, 1, 1 ) 148 ik = k_bot(ji,jj) 149 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 150 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 151 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 152 ! 153 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 154 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 155 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 156 END_2D 166 157 ! ! bottom scale factors and depth at U-, V-, UW and VW-points 167 158 pe3u (:,:,:) = pe3t(:,:,:) 168 159 pe3uw(:,:,:) = pe3w(:,:,:) 169 DO jk = 1, jpk ! Computed as the minimum of neighbooring scale factors 170 DO jj = 1, jpjm1 171 DO ji = 1, jpi 172 pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 173 pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 174 pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 175 END DO 176 END DO 177 END DO 160 DO_3D( 0, 0, 0, 0, 1, jpk ) 161 ! ! Computed as the minimum of neighbooring scale factors 162 pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 163 pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 164 pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 165 END_3D 178 166 CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp ) ; CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) 179 167 CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp ) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_cen2_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg
r12511 r13540 110 110 !! !! 111 111 !! namdrg top/bottom drag coefficient (default: NO selection) 112 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)113 !! namdrg_bot bottom friction (ln_ OFF=F)112 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 113 !! namdrg_bot bottom friction (ln_drg_OFF=F) 114 114 !! nambbc bottom temperature boundary condition (default: OFF) 115 115 !! nambbl bottom boundary layer scheme (default: OFF) … … 119 119 &namdrg ! top/bottom drag coefficient (default: NO selection) 120 120 !----------------------------------------------------------------------- 121 ln_ OFF = .true. ! free-slip : Cd = 0121 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 122 122 / 123 123 !!====================================================================== … … 137 137 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 138 138 ! ! S-EOS coefficients (nn_eos=1): 139 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS139 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 140 140 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 141 141 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_eenH_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_een_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ene_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_cen2_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_ubs_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_eenH_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_een_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ene_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ens_cfg
r12511 r13540 65 65 &namdrg ! top/bottom drag coefficient (default: NO selection) 66 66 !----------------------------------------------------------------------- 67 ln_ OFF = .true. ! free-slip : Cd = 067 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 68 68 / 69 69 !----------------------------------------------------------------------- … … 72 72 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 73 73 ! ! S-EOS coefficients (nn_eos=1): 74 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS74 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 75 75 rn_a0 = 0.2 ! thermal expension coefficient (nn_eos= 1) 76 76 rn_b0 = 0. ! saline expension coefficient (nn_eos= 1) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
r10074 r13540 13 13 !! usr_def_hgr : initialize the horizontal mesh for LOCK_EXCHANGE configuration 14 14 !!---------------------------------------------------------------------- 15 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain15 USE dom_oce 16 16 USE par_oce ! ocean space and time domain 17 17 USE phycst ! physical constants … … 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D( 1, 1, 1, 1 ) 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( mig0_oldcmp(ji)-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( mjg0_oldcmp(jj)-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain17 16 USE par_oce ! ocean space and time domain 18 17 USE phycst ! physical constants … … 85 84 WRITE(numout,*) ' vertical resolution rn_dz = ', rn_dz, ' meters' 86 85 WRITE(numout,*) ' LOCK_EXCHANGE domain = 64 km x 3 grid-points x 20 m' 87 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi88 WRITE(numout,*) ' jpjglo = ', kpj86 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 87 WRITE(numout,*) ' Nj0glo = ', kpj 89 88 WRITE(numout,*) ' jpkglo = ', kpk 90 89 WRITE(numout,*) ' ' -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_cen-ahm1000_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF = .true.! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_ubs_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF= .true. ! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_cen-ahm1000_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF = .true.! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_ubs_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF = .true.! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_zps_FCT2_flux_ubs_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF = .true.! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg
r12511 r13540 105 105 !! !! 106 106 !! namdrg top/bottom drag coefficient (default: NO selection) 107 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)108 !! namdrg_bot bottom friction (ln_ OFF=F)107 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 108 !! namdrg_bot bottom friction (ln_drg_OFF=F) 109 109 !! nambbc bottom temperature boundary condition (default: OFF) 110 110 !! nambbl bottom boundary layer scheme (default: OFF) … … 114 114 &namdrg ! top/bottom drag coefficient (default: NO selection) 115 115 !----------------------------------------------------------------------- 116 ln_ OFF= .true. ! free-slip : Cd = 0 (F => fill namdrg_bot116 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 117 117 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 118 118 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 136 136 !----------------------------------------------------------------------- 137 137 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 138 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS138 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 139 139 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 140 140 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_vect_een_cfg
r12511 r13540 71 71 &namdrg ! top/bottom drag coefficient (default: NO selection) 72 72 !----------------------------------------------------------------------- 73 ln_ OFF = .true.! free-slip : Cd = 0 (F => fill namdrg_bot73 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 74 74 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 75 75 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| … … 82 82 !----------------------------------------------------------------------- 83 83 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 84 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS84 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 85 85 rn_a0 = 0.2 ! thermal expension coefficient (for simplified equation of state) 86 86 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
r10074 r13540 13 13 !! usr_def_hgr : initialize the horizontal mesh for OVERFLOW configuration 14 14 !!---------------------------------------------------------------------- 15 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain15 USE dom_oce 16 16 USE par_oce ! ocean space and time domain 17 17 USE phycst ! physical constants … … 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D( 1, 1, 1, 1 ) 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( mig0_oldcmp(ji)-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( mjg0_oldcmp(jj)-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain17 16 USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate 18 17 USE par_oce ! ocean space and time domain … … 86 85 WRITE(numout,*) ' vertical resolution rn_dz = ', rn_dz, ' meters' 87 86 WRITE(numout,*) ' OVERFLOW domain = 200 km x 3 grid-points x 2000 m' 88 WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi89 WRITE(numout,*) ' jpjglo = ', kpj87 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 88 WRITE(numout,*) ' Nj0glo = ', kpj 90 89 WRITE(numout,*) ' jpkglo = ', kpk 91 90 ! -
NEMO/branches/2020/r12377_ticket2386/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
r12377 r13540 15 15 !!--------------------------------------------------------------------- 16 16 USE oce ! ocean variables 17 USE dom_oce , ONLY: mi0, mi1 , nimpp, njmpp! ocean space and time domain18 USE dom_oce , ONLY: glamt 17 USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain 18 USE dom_oce , ONLY: glamt ! ocean space and time domain 19 19 USE usrdef_nam ! User defined : namelist variables 20 20 ! … … 29 29 PUBLIC usr_def_zgr ! called by domzgr.F90 30 30 31 !! * Substitutions 32 # include "do_loop_substitute.h90" 31 33 !!---------------------------------------------------------------------- 32 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 182 184 pe3vw(:,:,jk) = pe3w_1d (jk) 183 185 END DO 184 DO jj = 1, jpj ! bottom scale factors and depth at T- and W-points 185 DO ji = 1, jpi 186 ik = k_bot(ji,jj) 187 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 188 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 189 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 190 ! 191 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 192 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 193 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 194 END DO 195 END DO 186 DO_2D( 1, 1, 1, 1 ) 187 ik = k_bot(ji,jj) 188 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 189 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 190 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 191 ! 192 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 193 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 194 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 195 END_2D 196 196 ! ! bottom scale factors and depth at U-, V-, UW and VW-points 197 197 ! ! usually Computed as the minimum of neighbooring scale factors -
NEMO/branches/2020/r12377_ticket2386/tests/README.rst
r11743 r13540 205 205 :style: unsrt 206 206 :labelprefix: T 207 208 CPL_OASIS 209 --------- 210 | This test case checks the OASIS interface in OCE/SBC, allowing to set up 211 a coupled configuration through OASIS. See CPL_OASIS/README.md for more information. -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/file_def_nemo-oce.xml
r11930 r13540 28 28 <field field_ref="empmr" name="empmr" /> 29 29 <!-- --> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 32 <!-- --> 33 <field field_ref="Cd_oce" name="Cd_oce" /> 34 <field field_ref="Ce_oce" name="Ce_oce" /> 35 <field field_ref="Ch_oce" name="Ch_oce" /> 36 <field field_ref="theta_zt" name="theta_zt" /> 37 <field field_ref="q_zt" name="q_zt" /> 38 <field field_ref="theta_zu" name="theta_zu" /> 39 <field field_ref="q_zu" name="q_zu" /> 40 <field field_ref="ssq" name="ssq" /> 41 <field field_ref="wspd_blk" name="wspd_blk" /> 32 42 </file> 33 43 -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/launch_sasf.sh
r11996 r13540 1 1 #!/bin/bash 2 2 3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 4 NEMO_DIR="${HOME}/NEMO/NEMOvdev_r11085_ASINTER-05_Brodeau_Advanced_Bulk" 3 ################################################################ 4 # 5 # Script to launch a set of STATION_ASF simulations 6 # 7 # L. Brodeau, 2020 8 # 9 ################################################################ 10 11 # What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 12 TC_DIR="STATION_ASF2" 13 14 expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 15 16 # NEMOGCM root directory: 17 NEMO_ROOT_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 18 19 # NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe: 20 SASF_WRK_DIR="${NEMO_ROOT_DIR}/tests/${TC_DIR}" 5 21 6 22 # Directory where to run the simulation: 7 WORK_DIR="${HOME}/tmp/STATION_ASF"23 PROD_DIR="${HOME}/tmp/STATION_ASF" 8 24 9 25 10 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 11 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 12 if [ `hostname` = "merlat" ]; then 13 FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 14 elif [ `hostname` = "luitel" ]; then 15 FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 16 elif [ `hostname` = "ige-meom-cal1" ]; then 17 FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 elif [ `hostname` = "salvelinus" ]; then 19 FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 else 21 echo "Boo!"; exit 22 fi 23 #====================== 24 mkdir -p ${WORK_DIR} 26 ####### End of normal user configurable section ####### 25 27 26 NEMO_EXE="${NEMO_DIR}/tests/STATION_ASF/BLD/bin/nemo.exe" 27 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 28 #================================================================================ 28 29 29 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF"30 if [ ! -d ${ NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi30 SASF_REF_DIR="${NEMO_ROOT_DIR}/tests/STATION_ASF" 31 if [ ! -d ${SASF_REF_DIR} ]; then echo " Mhhh, no EXPREF directory ${SASF_REF_DIR} !"; exit; fi 31 32 32 rsync -avP ${NEMO_EXE} ${WORK_DIR}/ 33 # NEMO executable to use is: 34 NEMO_EXE="${SASF_WRK_DIR}/BLD/bin/nemo.exe" 35 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 36 37 DATA_IN_DIR="${SASF_REF_DIR}/input_data" ; # Directory containing sea-surface + atmospheric input data 38 if [ ! -d ${DATA_IN_DIR} ]; then echo "PROBLEM!!! => did not find directory 'input_data' with input forcing..."; exit; fi 39 40 SASF_EXPREF=${SASF_REF_DIR}/${expdir} ; # STATION_ASF EXPREF directory from which to use namelists and XIOS xml files... 41 if [ ! -d ${SASF_EXPREF} ]; then echo " Mhhh, no ${expdir} directory ${SASF_EXPREF} !"; exit; fi 42 43 44 echo "###########################################################" 45 echo "# S T A T I O N A i r - S e a F l u x #" 46 echo "###########################################################" 47 echo 48 echo " * NEMO reference root directory is: ${NEMO_ROOT_DIR}" 49 echo " * STATION_ASF work directory is: ${SASF_WRK_DIR}" 50 echo " ==> NEMO EXE to use: ${NEMO_EXE}" 51 echo 52 echo " * Input forcing data into: ${DATA_IN_DIR}" 53 echo " * Production will be done into: ${PROD_DIR}" 54 echo " * Directory in which namelists and xml files are fetched:" 55 echo " ==> ${SASF_EXPREF}" 56 echo 57 58 mkdir -p ${PROD_DIR} 59 60 rsync -avP ${NEMO_EXE} ${PROD_DIR}/ 33 61 34 62 for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 35 if [ ! -f ${ NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi36 rsync -avPL ${ NEMO_EXPREF}/${ff} ${WORK_DIR}/63 if [ ! -f ${SASF_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${SASF_EXPREF} !"; exit; fi 64 rsync -avPL ${SASF_EXPREF}/${ff} ${PROD_DIR}/ 37 65 done 38 66 39 67 # Copy forcing to work directory: 40 rsync -avP ${ FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/68 rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 41 69 42 for CASE in "ECMWF -noskin" "COARE3p6-noskin" "ECMWF" "COARE3p6" "NCAR"; do70 for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 43 71 44 72 echo ; echo … … 50 78 scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 51 79 52 rm -f ${ WORK_DIR}/namelist_cfg53 rsync -avPL ${ NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg80 rm -f ${PROD_DIR}/namelist_cfg 81 rsync -avPL ${SASF_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 54 82 55 cd ${ WORK_DIR}/83 cd ${PROD_DIR}/ 56 84 echo 57 85 echo "Launching NEMO !" 58 ./nemo.exe 1> 86 ./nemo.exe 1>out_nemo.out 2>err_nemo.err 59 87 echo "Done!" 60 88 echo -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg
r12511 r13540 29 29 cn_exp = 'STATION_ASF-COARE3p6-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 195 201 !! !! 196 202 !! namdrg top/bottom drag coefficient (default: NO selection) 197 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)198 !! namdrg_bot bottom friction (ln_ OFF=F)203 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 204 !! namdrg_bot bottom friction (ln_drg_OFF=F) 199 205 !! nambbc bottom temperature boundary condition (default: OFF) 200 206 !! nambbl bottom boundary layer scheme (default: OFF) -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg
r12511 r13540 29 29 cn_exp = 'STATION_ASF-COARE3p6' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 195 201 !! !! 196 202 !! namdrg top/bottom drag coefficient (default: NO selection) 197 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)198 !! namdrg_bot bottom friction (ln_ OFF=F)203 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 204 !! namdrg_bot bottom friction (ln_drg_OFF=F) 199 205 !! nambbc bottom temperature boundary condition (default: OFF) 200 206 !! nambbl bottom boundary layer scheme (default: OFF) … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg
r12511 r13540 29 29 cn_exp = 'STATION_ASF-ECMWF-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 195 201 !! !! 196 202 !! namdrg top/bottom drag coefficient (default: NO selection) 197 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)198 !! namdrg_bot bottom friction (ln_ OFF=F)203 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 204 !! namdrg_bot bottom friction (ln_drg_OFF=F) 199 205 !! nambbc bottom temperature boundary condition (default: OFF) 200 206 !! nambbl bottom boundary layer scheme (default: OFF) -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg
r12511 r13540 29 29 cn_exp = 'STATION_ASF-ECMWF' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 195 201 !! !! 196 202 !! namdrg top/bottom drag coefficient (default: NO selection) 197 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)198 !! namdrg_bot bottom friction (ln_ OFF=F)203 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 204 !! namdrg_bot bottom friction (ln_drg_OFF=F) 199 205 !! nambbc bottom temperature boundary condition (default: OFF) 200 206 !! nambbl bottom boundary layer scheme (default: OFF) … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/namelist_ncar_cfg
r12511 r13540 29 29 cn_exp = 'STATION_ASF-NCAR' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 195 201 !! !! 196 202 !! namdrg top/bottom drag coefficient (default: NO selection) 197 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)198 !! namdrg_bot bottom friction (ln_ OFF=F)203 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 204 !! namdrg_bot bottom friction (ln_drg_OFF=F) 199 205 !! nambbc bottom temperature boundary condition (default: OFF) 200 206 !! nambbl bottom boundary layer scheme (default: OFF) … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/EXPREF/plot_station_asf.py
r12031 r13540 1 #!/usr/bin/env python 1 #!/usr/bin/env python3 2 2 # -*- Mode: Python; coding: utf-8; indent-tabs-mode: nil; tab-width: 4 -*- 3 3 4 # Post-diagnostic of STATION_ASF / L. Brodeau, 20 194 # Post-diagnostic of STATION_ASF / L. Brodeau, 2020 5 5 6 6 import sys 7 7 from os import path as path 8 #from string import replace9 8 import math 10 9 import numpy as nmp 11 #import scipy.signal as signal12 10 from netCDF4 import Dataset 13 11 import matplotlib as mpl … … 15 13 import matplotlib.pyplot as plt 16 14 import matplotlib.dates as mdates 17 #from string import find 18 #import warnings 19 #warnings.filterwarnings("ignore") 20 #import time 21 22 #import barakuda_plot as bp 23 #import barakuda_tool as bt 24 25 reload(sys) 26 sys.setdefaultencoding('utf8') 27 28 cy1 = '2016' ; # First year 15 16 cy1 = '2018' ; # First year 29 17 cy2 = '2018' ; # Last year 30 31 jt0 = 032 jt0 = 1751933 34 18 35 19 dir_figs='.' … … 53 37 L_VARL = [ r'$Q_{lat}$', r'$Q_{sens}$' , r'$Q_{net}$' , r'$Q_{lw}$' , r'$|\tau|$' , r'$\Delta T_{skin}$' ] ; # name of variable in latex mode 54 38 L_VUNT = [ r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$N/m^2$' , 'K' ] 55 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , -0.7 ]56 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , 39 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , 0.7 ] 40 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , -0.7 ] 57 41 L_ANOM = [ True , True , True , True , True , False ] 58 42 … … 72 56 narg = len(sys.argv) 73 57 if narg != 2: 74 print 'Usage: '+sys.argv[0]+' <DIR_OUT_SASF>'; sys.exit(0)58 print('Usage: '+sys.argv[0]+' <DIR_OUT_SASF>'); sys.exit(0) 75 59 cdir_data = sys.argv[1] 76 60 … … 82 66 def chck4f(cf): 83 67 cmesg = 'ERROR: File '+cf+' does not exist !!!' 84 if not path.exists(cf): print cmesg; sys.exit(0)68 if not path.exists(cf): print(cmesg); sys.exit(0) 85 69 86 70 ###cf_in = nmp.empty((), dtype="S10") … … 104 88 # Getting time array from the first file: 105 89 id_in = Dataset(cf_in[0]) 106 vt = id_in.variables['time_counter'][ jt0:]90 vt = id_in.variables['time_counter'][:] 107 91 cunit_t = id_in.variables['time_counter'].units ; print(' "time_counter" is in "'+cunit_t+'"') 108 92 id_in.close() … … 138 122 if ctest == 'skin': id_in = Dataset(cf_in[ja]) 139 123 if ctest == 'noskin': id_in = Dataset(cf_in_ns[ja]) 140 xF[:,ja] = id_in.variables[L_VNEM[jv]][ jt0:,1,1] # only the center point of the 3x3 spatial domain!124 xF[:,ja] = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 141 125 if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 142 126 id_in.close() … … 180 164 rmlt = 10.**(int(romagn)) / 2. 181 165 yrng = math.copysign( math.ceil(abs(rmax)/rmlt)*rmlt , rmax) 182 #print 'yrng = ', yrng ; #sys.exit(0)183 166 184 167 fig = plt.figure(num = 10+jv, figsize=size_fig, facecolor='w', edgecolor='k') … … 211 194 for ja in range(nb_algos-1): 212 195 id_in = Dataset(cf_in[ja]) 213 xF[:,ja] = id_in.variables[L_VNEM[jv]][ jt0:,1,1] # only the center point of the 3x3 spatial domain!196 xF[:,ja] = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 214 197 if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 215 198 id_in.close() 216 199 # 217 200 id_in = Dataset(cf_in_ns[ja]) 218 xFns[:,ja] = id_in.variables[L_VNEM[jv]][ jt0:,1,1] # only the center point of the 3x3 spatial domain!201 xFns[:,ja] = id_in.variables[L_VNEM[jv]][:,1,1] # only the center point of the 3x3 spatial domain! 219 202 if ja == 0: cvar_lnm = id_in.variables[L_VNEM[jv]].long_name 220 203 id_in.close() … … 229 212 rmlt = 10.**(int(romagn)) / 2. 230 213 yrng = math.copysign( math.ceil(abs(rmax)/rmlt)*rmlt , rmax) 231 print 'yrng = ', yrng ; #sys.exit(0) 232 233 234 235 214 215 236 216 for ja in range(nb_algos-1): 237 217 -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/diawri.F90
r12511 r13540 35 35 USE iom ! 36 36 USE ioipsl ! 37 37 38 #if defined key_si3 38 39 USE ice … … 56 57 57 58 !!---------------------------------------------------------------------- 58 !! NEMO/ SAS4.0 , NEMO Consortium (2018)59 !! $Id: diawri.F90 1 0425 2018-12-19 21:54:16Z smasson $59 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 60 !! $Id: diawri.F90 12493 2020-03-02 07:56:31Z smasson $ 60 61 !! Software governed by the CeCILL license (see ./LICENSE) 61 62 !!---------------------------------------------------------------------- … … 114 115 INTEGER, DIMENSION(2) :: ierr 115 116 !!---------------------------------------------------------------------- 116 ierr = 0 117 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 118 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 119 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 120 ! 121 dia_wri_alloc = MAXVAL(ierr) 122 CALL mpp_sum( 'diawri', dia_wri_alloc ) 117 IF( nn_write == -1 ) THEN 118 dia_wri_alloc = 0 119 ELSE 120 ierr = 0 121 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 122 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 123 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 124 ! 125 dia_wri_alloc = MAXVAL(ierr) 126 CALL mpp_sum( 'diawri', dia_wri_alloc ) 127 ! 128 ENDIF 123 129 ! 124 130 END FUNCTION dia_wri_alloc … … 374 380 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity 375 381 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity 376 382 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 377 383 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 378 384 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/nemogcm.F90
r12254 r13540 2 2 !!====================================================================== 3 3 !! *** MODULE nemogcm *** 4 !! StandAlone Surface module : surface fluxes4 !! STATION_ASF (SAS meets C1D) 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code … … 19 19 !!---------------------------------------------------------------------- 20 20 USE step_oce ! module used in the ocean time stepping module (step.F90) 21 USE sbc_oce ! surface boundary condition: ocean #LB: rm?22 21 USE phycst ! physical constant (par_cst routine) 23 22 USE domain ! domain initialization (dom_init & dom_cfg routines) 24 23 USE closea ! treatment of closed seas (for ln_closea) 25 24 USE usrdef_nam ! user defined configuration 25 USE istate ! initial state setting (istate_init routine) 26 26 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 27 27 USE daymod ! calendar 28 28 USE restart ! open restart file 29 !LB:USE step ! NEMO time-stepping (stp routine)30 29 USE c1d ! 1D configuration 31 30 USE step_c1d ! Time stepping loop for the 1D configuration 32 USE sbcssm !33 31 ! 32 USE prtctl ! Print control 33 USE in_out_manager ! I/O manager 34 34 USE lib_mpp ! distributed memory computing 35 35 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 49 49 !!---------------------------------------------------------------------- 50 50 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 51 !! $Id: nemogcm.F90 1 1536 2019-09-11 13:54:18Z smasson$51 !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $ 52 52 !! Software governed by the CeCILL license (see ./LICENSE) 53 53 !!---------------------------------------------------------------------- … … 84 84 ! !== time stepping ==! 85 85 ! !-----------------------! 86 ! 87 ! !== set the model time-step ==! 88 ! 86 89 istp = nit000 87 90 ! … … 98 101 IF( nstop /= 0 .AND. lwp ) THEN ! error print 99 102 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 100 CALL ctl_stop( ctmp1 ) 103 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 104 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 101 105 ENDIF 102 106 ! … … 106 110 ! 107 111 #if defined key_iomput 108 CALL xios_finalize ! end mpp communications with xios112 CALL xios_finalize ! end mpp communications with xios 109 113 #else 110 IF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 111 ENDIF 114 IF( lk_mpp ) CALL mppstop ! end mpp communications 112 115 #endif 113 116 ! … … 129 132 INTEGER :: ios, ilocal_comm ! local integers 130 133 !! 131 NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, & 132 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 133 & ln_timing, ln_diacfl 134 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 135 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 134 136 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 135 137 !!---------------------------------------------------------------------- … … 161 163 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 162 164 ! open reference and configuration namelist files 163 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )164 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )165 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm ) 166 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm ) 165 167 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 166 168 ! open /dev/null file to be able to supress output write easily 167 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 169 IF( Agrif_Root() ) THEN 170 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 171 #ifdef key_agrif 172 ELSE 173 numnul = Agrif_Parent(numnul) 174 #endif 175 ENDIF 168 176 ! 169 177 ! !--------------------! … … 177 185 ! 178 186 ! finalize the definition of namctl variables 179 IF( sn_cfctl%l_allon ) THEN 180 ! Turn on all options. 181 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 182 ! Ensure all processors are active 183 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 184 ELSEIF( sn_cfctl%l_config ) THEN 185 ! Activate finer control of report outputs 186 ! optionally switch off output from selected areas (note this only 187 ! applies to output which does not involve global communications) 188 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 189 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 190 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 191 ELSE 192 ! turn off all options. 193 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 194 ENDIF 187 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 188 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 195 189 ! 196 190 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 235 229 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 236 230 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 237 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 231 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 238 232 ! 239 233 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 240 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )234 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 241 235 ELSE ! user-defined namelist 242 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )236 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 243 237 ENDIF 244 238 ! … … 266 260 IF( ln_timing ) CALL timing_start( 'nemo_init') 267 261 ! 268 CALL phy_cst ! Physical constants269 CALL eos_init ! Equation of state262 CALL phy_cst ! Physical constants 263 CALL eos_init ! Equation of state 270 264 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 271 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain265 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 272 266 IF( sn_cfctl%l_prtctl ) & 273 267 & CALL prt_ctl_init ! Print control 274 275 IF( ln_rstart ) THEN ! Restart from a file 276 ! ! ------------------- 277 CALL rst_read( Nbb, Nnn ) ! Read the restart file 278 CALL day_init ! model calendar (using both namelist and restart infos) 279 ! 280 ELSE ! Start from rest 281 ! ! --------------- 282 numror = 0 ! define numror = 0 -> no restart file to read 283 neuler = 0 ! Set time-step indicator at nit000 (euler forward) 284 CALL day_init ! model calendar (using both namelist and restart infos) 285 ENDIF 286 ! 287 288 ! ! external forcing 289 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 268 ! 269 270 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 271 272 ! ! external forcing 273 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 290 274 291 275 ! … … 311 295 WRITE(numout,*) '~~~~~~~~' 312 296 WRITE(numout,*) ' Namelist namctl' 313 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk314 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon315 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config316 297 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 317 298 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 321 302 WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc 322 303 WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout 323 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 324 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 325 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 326 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 327 WRITE(numout,*) ' level of print nn_print = ', nn_print 328 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls 329 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle 330 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls 331 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle 332 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt 333 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 304 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 305 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 306 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 307 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 334 308 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 335 309 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 336 310 ENDIF 337 311 ! 338 nprint = nn_print ! convert DOCTOR namelist names into OLD names 339 nictls = nn_ictls 340 nictle = nn_ictle 341 njctls = nn_jctls 342 njctle = nn_jctle 343 isplt = nn_isplt 344 jsplt = nn_jsplt 345 312 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 346 313 IF(lwp) THEN ! control print 347 314 WRITE(numout,*) … … 354 321 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 355 322 ENDIF 356 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file357 !358 ! ! Parameter control359 !360 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints361 IF( lk_mpp .AND. jpnij > 1 ) THEN362 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain363 ELSE364 IF( isplt == 1 .AND. jsplt == 1 ) THEN365 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &366 & ' - the print control will be done over the whole domain' )367 ENDIF368 ijsplt = isplt * jsplt ! total number of processors ijsplt369 ENDIF370 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'371 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt372 !373 ! ! indices used for the SUM control374 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area375 lsp_area = .FALSE.376 ELSE ! print control done over a specific area377 lsp_area = .TRUE.378 IF( nictls < 1 .OR. nictls > jpiglo ) THEN379 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )380 nictls = 1381 ENDIF382 IF( nictle < 1 .OR. nictle > jpiglo ) THEN383 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )384 nictle = jpiglo385 ENDIF386 IF( njctls < 1 .OR. njctls > jpjglo ) THEN387 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )388 njctls = 1389 ENDIF390 IF( njctle < 1 .OR. njctle > jpjglo ) THEN391 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )392 njctle = jpjglo393 ENDIF394 ENDIF395 ENDIF396 323 ! 397 324 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 439 366 !!---------------------------------------------------------------------- 440 367 ! 441 ierr = oce_alloc () ! ocean 368 ierr = oce_alloc () ! ocean 442 369 ierr = ierr + dia_wri_alloc() 443 370 ierr = ierr + dom_oce_alloc() ! ocean domain … … 448 375 END SUBROUTINE nemo_alloc 449 376 450 451 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)377 378 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 452 379 !!---------------------------------------------------------------------- 453 380 !! *** ROUTINE nemo_set_cfctl *** 454 381 !! 455 382 !! ** Purpose : Set elements of the output control structure to setto. 456 !! for_all should be .false. unless all areas are to be457 !! treated identically.458 383 !! 459 384 !! ** Method : Note this routine can be used to switch on/off some 460 !! types of output for selected areas but any output types 461 !! that involve global communications (e.g. mpp_max, glob_sum) 462 !! should be protected from selective switching by the 463 !! for_all argument 464 !!---------------------------------------------------------------------- 465 LOGICAL :: setto, for_all 466 TYPE(sn_ctl) :: sn_cfctl 467 !!---------------------------------------------------------------------- 468 IF( for_all ) THEN 469 sn_cfctl%l_runstat = setto 470 sn_cfctl%l_trcstat = setto 471 ENDIF 385 !! types of output for selected areas. 386 !!---------------------------------------------------------------------- 387 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 388 LOGICAL , INTENT(in ) :: setto 389 !!---------------------------------------------------------------------- 390 sn_cfctl%l_runstat = setto 391 sn_cfctl%l_trcstat = setto 472 392 sn_cfctl%l_oceout = setto 473 393 sn_cfctl%l_layout = setto … … 479 399 !!====================================================================== 480 400 END MODULE nemogcm 401 -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/sbcssm.F90
r12249 r13540 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/SAS 4.0 , NEMO Consortium (2018) 56 !! $Id: sbcssm.F90 1 0068 2018-08-28 14:09:04Z nicolasmartin$56 !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $ 57 57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/step_c1d.F90
r12249 r13540 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 28 !! $Id: step_c1d.F90 1 0068 2018-08-28 14:09:04Z nicolasmartin$28 !! $Id: step_c1d.F90 12377 2020-02-12 14:39:06Z acc $ 29 29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- … … 64 64 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 65 65 66 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 67 ! diagnostics and outputs 68 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 66 69 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs 67 70 … … 75 78 ! Control and restarts 76 79 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 77 CALL stp_ctl( kstp, Nbb, Nnn, indic ) 80 CALL stp_ctl( kstp, Nnn ) 81 78 82 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 79 83 IF( lrst_oce ) CALL rst_write( kstp, Nbb, Nnn ) ! write output ocean restart file 80 84 ! 81 85 #if defined key_iomput 82 IF( kstp == nitend .OR. indic <0 ) CALL xios_context_finalize() ! needed for XIOS86 IF( kstp == nitend .OR. nstop > 0 ) CALL xios_context_finalize() ! needed for XIOS 83 87 ! 84 88 #endif -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/stpctl.F90
r12254 r13540 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE sbc_oce ! surface fluxes and stuff 21 ! 21 22 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 23 USE in_out_manager ! I/O manager 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing 26 26 ! 27 27 USE netcdf ! NetCDF library 28 28 IMPLICIT NONE … … 31 31 PUBLIC stp_ctl ! routine called by step.F90 32 32 33 INTEGER :: idrun, idtime, idtau, idqns, idemp, istatus34 LOGICAL :: lsomeoce33 INTEGER :: nrunid ! netcdf file id 34 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 40 40 CONTAINS 41 41 42 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)42 SUBROUTINE stp_ctl( kt, Kmm ) 43 43 !!---------------------------------------------------------------------- 44 44 !! *** ROUTINE stp_ctl *** 45 !! 45 !! 46 46 !! ** Purpose : Control the run 47 47 !! 48 48 !! ** Method : - Save the time step in numstp 49 !! - Print it each 50 time steps 50 !! - Stop the run IF problem encountered by setting indic=-3 49 !! - Stop the run IF problem encountered by setting nstop > 0 50 !! Problems checked: wind stress module max larger than 5 N/m^2 51 !! non-solar heat flux max larger than 2000 W/m^2 52 !! Evaporation-Precip max larger than 1.E-3 kg/m^2/s 51 53 !! 52 54 !! ** Actions : "time.step" file = last ocean time-step 53 55 !! "run.stat" file = run statistics 54 !! nstop indicator sheared among all local domain (lk_mpp=T)56 !! nstop indicator sheared among all local domain 55 57 !!---------------------------------------------------------------------- 56 58 INTEGER, INTENT(in ) :: kt ! ocean time-step index 57 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 58 INTEGER, INTENT(inout) :: kindic ! error indicator 59 !! 60 REAL(wp), DIMENSION(3) :: zmax 61 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 62 CHARACTER(len=20) :: clname 63 !!---------------------------------------------------------------------- 64 ! 65 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 66 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 67 ll_wrtruns = ll_colruns .AND. lwm 68 IF( kt == nit000 .AND. lwp ) THEN 69 WRITE(numout,*) 70 WRITE(numout,*) 'stp_ctl : time-stepping control' 71 WRITE(numout,*) '~~~~~~~' 72 ! ! open time.step file 73 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 74 ! ! open run.stat file(s) at start whatever 75 ! ! the value of sn_cfctl%ptimincr 76 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 59 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 60 !! 61 INTEGER :: ji ! dummy loop indices 62 INTEGER :: idtime, istatus 63 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 64 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 65 REAL(wp) :: zzz ! local real 66 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 67 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 68 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 69 CHARACTER(len=20) :: clname 70 !!---------------------------------------------------------------------- 71 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 72 ! 73 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 74 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 75 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 76 ! 77 IF( kt == nit000 ) THEN 78 ! 79 IF( lwp ) THEN 80 WRITE(numout,*) 81 WRITE(numout,*) 'stp_ctl : time-stepping control' 82 WRITE(numout,*) '~~~~~~~' 83 ENDIF 84 ! ! open time.step ascii file, done only by 1st subdomain 85 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 86 ! 87 IF( ll_wrtruns ) THEN 88 ! ! open run.stat ascii file, done only by 1st subdomain 77 89 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 90 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 78 91 clname = 'run.stat.nc' 79 92 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 80 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 81 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 82 istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 83 istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns ) 84 istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp ) 85 istatus = NF90_ENDDEF(idrun) 86 ENDIF 87 ENDIF 88 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 89 ! 90 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 93 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 94 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 95 istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 96 istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 97 istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 98 istatus = NF90_ENDDEF(nrunid) 99 ENDIF 100 ! 101 ENDIF 102 ! 103 ! !== write current time step ==! 104 ! !== done only by 1st subdomain at writting timestep ==! 105 IF( lwm .AND. ll_wrtstp ) THEN 91 106 WRITE ( numstp, '(1x, i8)' ) kt 92 107 REWIND( numstp ) 93 108 ENDIF 94 ! 95 ! !== test of extrema ==! 96 zmax(1) = MAXVAL( taum(:,:) , mask = tmask(:,:,1) == 1._wp ) ! max wind stress module 97 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max non-solar heat flux 98 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max E-P 99 ! 109 ! !== test of local extrema ==! 110 ! !== done by all processes at every time step ==! 111 ! 112 llmsk( 1:Nis1,:) = .FALSE. ! exclude halos from the checked region 113 llmsk(Nie1: jpi,:) = .FALSE. 114 llmsk(:, 1:Njs1) = .FALSE. 115 llmsk(:,Nje1: jpj) = .FALSE. 116 ! 117 llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! test only the inner domain 118 IF( COUNT( llmsk(:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 119 zmax(1) = MAXVAL( taum(:,:) , mask = llmsk ) ! max wind stress module 120 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk ) ! max non-solar heat flux 121 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk ) ! max E-P 122 ELSE 123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 124 zmax(1:3) = -HUGE(1._wp) 125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 126 zmax(1:3) = 0._wp 127 ENDIF 128 ENDIF 129 zmax(4) = REAL( nstop, wp ) ! stop indicator 130 ! !== get global extrema ==! 131 ! !== done by all processes if writting run.stat ==! 100 132 IF( ll_colruns ) THEN 133 zmaxlocal(:) = zmax(:) 101 134 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 102 nstop = NINT( zmax(3) ) ! nstop indicator sheared among all local domains 103 ENDIF 104 ! !== run statistics ==! ("run.stat" files) 135 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 136 ENDIF 137 ! !== write "run.stat" files ==! 138 ! !== done only by 1st subdomain at writting timestep ==! 105 139 IF( ll_wrtruns ) THEN 106 140 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 107 istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 108 istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 109 istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 110 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 111 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 141 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 142 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 143 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/ zmax(3)/), (/kt/), (/1/) ) 144 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 112 145 END IF 113 ! !== error handling ==! 114 IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. ( & ! domain contains some ocean points, check for sensible ranges 115 & zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 116 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2) 117 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( kg/m^2/s) 118 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 119 120 !! We are 1D so no need to find a spatial location of the rogue point. 121 146 ! !== error handling ==! 147 ! !== done by all processes at every time step ==! 148 ! 149 IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 150 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 ) 151 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 152 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 153 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 154 ! 155 iloc(:,:) = 0 156 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 157 ! first: close the netcdf file, so we can read it 158 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 159 ! get global loc on the min/max 160 CALL mpp_maxloc( 'stpctl', taum(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 161 CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) ) 162 CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) ) 163 ! find which subdomain has the max. 164 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 165 DO ji = 1, 4 166 IF( zmaxlocal(ji) == zmax(ji) ) THEN 167 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 168 ENDIF 169 END DO 170 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 171 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 172 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 173 ELSE ! find local min and max locations: 174 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 175 iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk ) 176 iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) 177 iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) 178 DO ji = 1, 3 ! local domain indices ==> global domain indices, excluding halos 179 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 180 END DO 181 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 182 ENDIF 183 ! 122 184 WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2 or |qns| > 2000 W/m2 or |emp| > 1.E-3 or NaN encounter in the tests' 123 WRITE(ctmp2,9500) kt, zmax(1), zmax(2), zmax(3) 124 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 125 185 CALL wrt_line( ctmp2, kt, '|tau| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 186 CALL wrt_line( ctmp3, kt, '|qns| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 187 CALL wrt_line( ctmp4, kt, 'emp max', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 188 IF( Agrif_Root() ) THEN 189 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 190 ELSE 191 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 192 ENDIF 193 ! 126 194 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 127 128 IF( .NOT. sn_cfctl%l_glochk ) THEN 129 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 130 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 131 ELSE 132 CALL ctl_stop( ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 133 ENDIF 134 135 kindic = -3 136 ! 195 ! 196 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 197 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 198 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 199 ENDIF 200 ELSE ! only mpi subdomains with errors are here -> STOP now 201 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 202 ENDIF 203 ! 204 ENDIF 205 ! 206 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 207 ngrdstop = Agrif_Fixed() ! store which grid got this error 208 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 137 209 ENDIF 138 210 ! … … 140 212 ! 141 213 END SUBROUTINE stp_ctl 214 215 216 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 217 !!---------------------------------------------------------------------- 218 !! *** ROUTINE wrt_line *** 219 !! 220 !! ** Purpose : write information line 221 !! 222 !!---------------------------------------------------------------------- 223 CHARACTER(len=*), INTENT( out) :: cdline 224 CHARACTER(len=*), INTENT(in ) :: cdprefix 225 REAL(wp), INTENT(in ) :: pval 226 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 227 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 228 ! 229 CHARACTER(len=80) :: clsuff 230 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 231 CHARACTER(len=9 ) :: cli, clj, clk 232 CHARACTER(len=1 ) :: clfmt 233 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 234 INTEGER :: ifmtk 235 !!---------------------------------------------------------------------- 236 WRITE(clkt , '(i9)') kt 237 238 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 239 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 240 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 241 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 242 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 243 WRITE(clmax, cl4) kmax-1 244 ! 245 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 246 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 247 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 248 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 249 ! 250 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 251 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 252 ENDIF 253 IF(kloc(3) == 0) THEN 254 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 255 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 256 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 257 ELSE 258 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 259 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 260 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 261 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 262 ENDIF 263 ! 264 9100 FORMAT('MPI rank ', a) 265 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 266 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 267 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 268 ! 269 END SUBROUTINE wrt_line 270 142 271 143 272 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
r11930 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain17 16 USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 18 17 USE par_oce ! ocean space and time domain … … 30 29 !!---------------------------------------------------------------------- 31 30 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_hgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin $31 !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $ 33 32 !! Software governed by the CeCILL license (see ./LICENSE) 34 33 !!---------------------------------------------------------------------- … … 54 53 !! 55 54 !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 56 !! - define coriolis parameter at f-point if the domain in not on the sphere 55 !! - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 57 56 !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 58 57 !! - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
r12249 r13540 8 8 !!====================================================================== 9 9 !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! History :4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS)10 !! 4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS) 11 11 !!---------------------------------------------------------------------- 12 12 … … 15 15 !! usr_def_hgr : initialize the horizontal mesh 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain18 USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate19 17 USE par_oce ! ocean space and time domain 20 18 USE phycst ! physical constants … … 33 31 !!---------------------------------------------------------------------- 34 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 35 !! $Id: usrdef_nam.F90 1 1536 2019-09-11 13:54:18Z smasson$33 !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $ 36 34 !! Software governed by the CeCILL license (see ./LICENSE) 37 35 !!---------------------------------------------------------------------- … … 68 66 kk_cfg = 0 69 67 70 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 75or vertical levels68 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 2 or vertical levels 71 69 kpi = 3 72 70 kpj = 3 73 kpk = 171 kpk = 2 ! 2, rather than 1, because 1 would cause some issues... like overflow in array boundary indexes, etc... 74 72 ! 75 73 ! ! Set the lateral boundary condition of the global domain -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
r12038 r13540 1 1 MODULE usrdef_zgr 2 2 !!====================================================================== 3 !! *** MODULEusrdef_zgr ***3 !! *** MODULE usrdef_zgr *** 4 4 !! 5 5 !! === STATION_ASF case === 6 6 !! 7 !! user defined :vertical coordinate system of a user configuration7 !! User defined : vertical coordinate system of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2019-10 (L. Brodeau) Original code 9 !! History : 4.0 ! 2016-06 (G. Madec) Original code 10 !! 4.x ! 2019-10 (L. Brodeau) Station ASF 10 11 !!---------------------------------------------------------------------- 11 12 12 13 !!---------------------------------------------------------------------- 13 !! usr_def_zgr : user defined vertical coordinate system (required) 14 !! usr_def_zgr : user defined vertical coordinate system 15 !! zgr_z : reference 1D z-coordinate 16 !! zgr_top_bot: ocean top and bottom level indices 17 !! zgr_zco : 3D verticl coordinate in pure z-coordinate case 14 18 !!--------------------------------------------------------------------- 15 19 USE oce ! ocean variables 16 !USE dom_oce ! ocean domain17 !USE depth_e3 ! depth <=> e318 20 USE usrdef_nam ! User defined : namelist variables 19 21 ! … … 21 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 24 USE lib_mpp ! distributed memory computing library 23 USE timing ! Timing24 25 25 26 IMPLICIT NONE 26 27 PRIVATE 27 28 28 PUBLIC usr_def_zgr ! called by domzgr.F9029 PUBLIC usr_def_zgr ! called by domzgr.F90 29 30 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_zgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin$33 !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $ 33 34 !! Software governed by the CeCILL license (see ./LICENSE) 34 35 !!---------------------------------------------------------------------- … … 47 48 !! 48 49 !!---------------------------------------------------------------------- 49 LOGICAL , INTENT( out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags ( read in namusr_def )50 LOGICAL , INTENT( 51 REAL(wp), DIMENSION(:) , INTENT( 52 REAL(wp), DIMENSION(:) , INTENT( 53 REAL(wp), DIMENSION(:,:,:), INTENT( 54 REAL(wp), DIMENSION(:,:,:), INTENT( 55 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! i-scale factors56 INTEGER , DIMENSION(:,:) , INTENT( 50 LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags 51 LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag 52 REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m] 53 REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m] 54 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m] 55 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m] 56 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors 57 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 61 62 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 62 63 ! 63 64 ! 65 ! type of vertical coordinate 66 ! --------------------------- 64 67 ld_zco = .TRUE. ! z-coordinate without ocean cavities 65 68 ld_zps = .FALSE. 66 69 ld_sco = .FALSE. 67 70 ld_isfcav = .FALSE. 68 71 72 !! 1st level (the only one that matters) 69 73 pdept_1d(1) = rn_dept1 ! depth (m) at which the SST is taken/measured == depth of first T point! 70 74 pdepw_1d(1) = 0._wp … … 72 76 pe3w_1d(1) = rn_dept1 ! LB??? 73 77 74 pdept(:,:,:) = rn_dept1 75 pdepw(:,:,:) = 0._wp 76 pe3t(:,:,:) = 2._wp*rn_dept1 77 pe3u(:,:,:) = 2._wp*rn_dept1 78 pe3v(:,:,:) = 2._wp*rn_dept1 79 pe3f(:,:,:) = 2._wp*rn_dept1 80 pe3w(:,:,:) = rn_dept1 ! LB??? 81 pe3uw(:,:,:) = rn_dept1 ! LB??? 82 pe3vw(:,:,:) = rn_dept1 ! LB??? 78 pdept(:,:,1) = rn_dept1 79 pdepw(:,:,1) = 0._wp 80 pe3t(:,:,1) = 2._wp*rn_dept1 81 pe3u(:,:,1) = 2._wp*rn_dept1 82 pe3v(:,:,1) = 2._wp*rn_dept1 83 pe3f(:,:,1) = 2._wp*rn_dept1 84 pe3w(:,:,1) = rn_dept1 ! LB??? 85 pe3uw(:,:,1) = rn_dept1 ! LB??? 86 pe3vw(:,:,1) = rn_dept1 ! LB??? 87 88 !! 2nd level, technically useless (only for the sake of code stability) 89 pdept_1d(2) = 3._wp*rn_dept1 90 pdepw_1d(2) = 2._wp*rn_dept1 91 pe3t_1d(2) = 2._wp*rn_dept1 92 pe3w_1d(2) = 2._wp*rn_dept1 93 94 pdept(:,:,2) = 3._wp*rn_dept1 95 pdepw(:,:,2) = 2._wp*rn_dept1 96 pe3t(:,:,2) = 2._wp*rn_dept1 97 pe3u(:,:,2) = 2._wp*rn_dept1 98 pe3v(:,:,2) = 2._wp*rn_dept1 99 pe3f(:,:,2) = 2._wp*rn_dept1 100 pe3w(:,:,2) = 2._wp*rn_dept1 101 pe3uw(:,:,2) = 2._wp*rn_dept1 102 pe3vw(:,:,2) = 2._wp*rn_dept1 103 83 104 k_top = 1 84 105 k_bot = 1 85 ! 106 86 107 END SUBROUTINE usr_def_zgr 87 108 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/tests/STATION_ASF/README.md
r12031 r13540 1 # *Station Air-Sea Fluxes* demonstration case 1 2 2 ## WARNING: TOTALLY-ALPHA-STUFF / DOCUMENT IN THE PROCESS OF BEING WRITEN! 3 Last successful test done with NEMOGCM trunk: `r13263` 3 4 4 # *Station Air-Sea Fluxes* demonstration case 5 Author: Laurent Brodeau, 2020 6 7 NOTE: if working with the trunk of NEMO, you are strongly advised to use the same test-case but on the `NEMO-examples` GitHub depo: 8 https://github.com/NEMO-ocean/NEMO-examples/tree/master/STATION_ASF 5 9 6 10 ## Objectives 7 11 8 ```STATION_ASF``` is a demonstration case that mimics an in-situ station (buoy, platform) dedicated to the estimation of surface air-sea fluxes by means of the measurement of traditionalmeteorological surface parameters.12 ```STATION_ASF``` is a demonstration test-case that mimics a (static) in-situ station (buoy, platform) dedicated to the estimation of surface air-sea fluxes by means of *widely-measured* (bulk) meteorological surface parameters. 9 13 10 ```STATION_ASF``` is based on the merging of the "single column" and the "standalone surface module" configurations of NEMO. In short, it coulbdefined as "SAS meets C1D". As such, the spatial domain of ```STATION_ASF``` is punctual (1D, well actually 3 x 3 as in C1D).14 ```STATION_ASF``` has been constructed by merging the *single column* and the *standalone surface module* configurations of NEMO. In short, it can be defined as "SAS meets C1D". As such, the spatial domain of ```STATION_ASF``` is punctual (1D, well actually 3 x 3 as in C1D). 11 15 12 ```STATION_ASF``` is therefore a versatile tool, and extremely light in terms of computing requirements, to test the different bulk algorithms and cool-skin/warm-layer parameterization options included in NEMO.16 ```STATION_ASF``` is therefore a versatile tool, and extremely lightweight in terms of computing requirements, to test the different bulk algorithms and cool-skin/warm-layer parameterization options included in NEMO. 13 17 14 18 As input ```STATION_ASF``` will require the traditional *bulk* sea surface parameters: 15 19 16 - sea surface temperature (SST) at $z_{SST}$meters below the surface20 - Bulk sea surface temperature (SST) at _z<sub>SST</sub>_ meters below the surface 17 21 - Surface current vector 18 22 - Sea surface salinity … … 20 24 as well as the usual surface atmospheric state: 21 25 22 - air temperature at $z_t$meters above the surface23 - air humidity at $z_t$meters above the surface (specific humidity or relative humidity or dew-point temperature)24 - wind speed vector at $z_u$meters above the surface26 - air temperature at _z<sub>t</sub>_ meters above the surface 27 - air humidity at _z<sub>t</sub>_ meters above the surface (specific humidity or relative humidity or dew-point temperature) 28 - wind speed vector at _z<sub>u</sub>_ meters above the surface 25 29 - Sea level atmospheric pressure (SLP) 26 30 - Downwelling solar radiation 27 31 - Downwelling longwave radiation 28 32 33 ### Example of diagnostics from `STATION_ASF` 34 35 (Generated with script `./EXPREF/plot_station_asf_simple.py`) 36 37 ![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/01_temperatures_ECMWF.svg) 38 39 ![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/Cd.svg) 40 41 ![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/dT_skin.svg) 42 43 ![plot](https://github.com/NEMO-ocean/NEMO-examples/blob/master/STATION_ASF/figs/Qlat.svg) 29 44 30 45 31 46 ## Physical description 32 47 33 ### Important namelist parameters spe ficic to STATION_ASF48 ### Important namelist parameters specific to STATION_ASF 34 49 35 * ```rn_dept1@namusr_def:``` depth (m) at which the prescribed SST is taken ( i.e.depth of first T-point); important due to impact on warm-layer estimate, the deeper, the more pronounced!50 * ```rn_dept1@namusr_def:``` depth (m) at which the prescribed SST is taken (*i.e.* depth of first T-point); important due to impact on warm-layer estimate, the deeper, the more pronounced! 36 51 37 52 * ```rn_lat1d,rn_lon1d@namc1d:``` fixed coordinates of the location of the station (buoy, platform, etc). … … 45 60 ## Input files to test STATION ASF 46 61 47 Three full years of processed hourly data from the PAPA station (buoy) can be downloaded here: 48 https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/ 62 One full year (2018) of processed hourly data from the PAPA station (buoy) is found into the `input_data` directory. 63 These three files are everything you need to play with the set of *namelists* provided for this test-case. 49 64 50 These three files are everything you need to play with the set of namelists provided for this test-case. 51 52 - ```Station_PAPA_50N-145W_atm_hourly.nc``` → contains hourly surface atmospheric state 53 - ```Station_PAPA_50N-145W_precip_daily.nc``` → contains daily precipitation 54 - ```Station_PAPA_50N-145W_oce_hourly.nc``` → contains hourly sea surface state 65 - ```Station_PAPA_50N-145W_atm_hourly_y2018.nc``` → contains hourly surface atmospheric state 66 - ```Station_PAPA_50N-145W_precip_daily_y2018.nc``` → contains daily precipitation 67 - ```Station_PAPA_50N-145W_oce_hourly_y2018.nc``` → contains hourly sea surface state 55 68 56 69 For station PAPA (50.1 N, 144.9 W), air temperature and humidity are measured at 2.5 m, the wind speed at 4 m, and the SST at 1 m below the surface, hence the following namelist parameters are given: 57 70 58 - ```rn_dept1 = 1. ``` (&namusr_def) 59 - ```rn_lat1d = 50.1 ``` (&namc1d) 60 - ```rn_lon1d = 215.1``` (&namc1d) 61 - ```rn_zqt = 2.5``` (&namsbc_blk) 62 - ```rn_zu = 4.``` (&namsbc_blk) 71 - `&namusr_def` 72 - ```rn_dept1 = 1. ``` 73 - `&namc1d` 74 - ```rn_lat1d = 50.1 ``` 75 - ```rn_lon1d = 215.1``` 76 - `&namsbc_blk` 77 - ```rn_zqt = 2.5``` 78 - ```rn_zu = 4.``` 63 79 64 80 … … 68 84 First compile the test-case as follows (compile with xios-2.5 support → check your ARCH file): 69 85 70 ```./makenemo - m <your_arch> -n STATION_ASF -j 4 -a STATION_ASF```86 ```./makenemo -a STATION_ASF -m <your_arch> -n STATION_ASF2 -j 4``` 71 87 72 88 Then you can use the script ``launch_sasf.sh`` found in ```EXPREF/``` to launch 3 simulations (one for each bulk parameterization available). You need to adapt the following variable to your environment in the script: 73 89 74 - ```NEMO_ DIR``` : NEMO root directory where to fetch compiled STATION_ASF ```nemo.exe``` + setup (such as ```${NEMO_DIR}/tests/STATION_ASF```)90 - ```NEMO_ROOT_DIR``` : NEMO root directory where to fetch compiled STATION_ASF ```nemo.exe``` + setup (such as ```${NEMO_ROOT_DIR}/tests/STATION_ASF```) 75 91 76 - ``` WORK_DIR``` : Directory where to run the simulation92 - ```PROD_DIR``` : Directory where to run the simulation 77 93 78 - ``` FORC_DIR``` Directory containing sea-surface + atmospheric forcings (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/)94 - ```DATA_IN_DIR``` : Directory containing sea-surface + atmospheric forcings (found here in ```input_data/```) 79 95 96 If everything goes according to plan, ``launch_sasf.sh`` should have generated the 3 following sets of output files into `${PROD_DIR}/output`: 97 98 STATION_ASF-COARE3p6_1h_20180101_20181231_gridT.nc 99 STATION_ASF-COARE3p6_1h_20180101_20181231_gridU.nc 100 STATION_ASF-COARE3p6_1h_20180101_20181231_gridV.nc 101 STATION_ASF-ECMWF_1h_20180101_20181231_gridT.nc 102 STATION_ASF-ECMWF_1h_20180101_20181231_gridU.nc 103 STATION_ASF-ECMWF_1h_20180101_20181231_gridV.nc 104 STATION_ASF-NCAR_1h_20180101_20181231_gridT.nc 105 STATION_ASF-NCAR_1h_20180101_20181231_gridU.nc 106 STATION_ASF-NCAR_1h_20180101_20181231_gridV.nc 107 108 --- 109 110 */Laurent, July 2020.* 111 -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/EXPREF/1_context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/EXPREF/1_namelist_cfg
r12511 r13540 98 98 &namagrif ! AGRIF zoom ("key_agrif") 99 99 !----------------------------------------------------------------------- 100 ln_spc_dyn = .true. ! use 0 as special value for dynamics 101 rn_sponge_tra = 800. ! coefficient for tracer sponge layer [m2/s] 102 rn_sponge_dyn = 800. ! coefficient for dynamics sponge layer [m2/s] 103 ln_chk_bathy = .FALSE. ! 100 rn_sponge_tra = 0.00768 ! coefficient for tracer sponge layer [] 101 rn_sponge_dyn = 0.00768 ! coefficient for dynamics sponge layer [] 104 102 / 105 103 !!====================================================================== … … 107 105 !! !! 108 106 !! namdrg top/bottom drag coefficient (default: NO selection) 109 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)110 !! namdrg_bot bottom friction (ln_ OFF=F)107 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 108 !! namdrg_bot bottom friction (ln_drg_OFF=F) 111 109 !! nambbc bottom temperature boundary condition (default: OFF) 112 110 !! nambbl bottom boundary layer scheme (default: OFF) … … 116 114 &namdrg ! top/bottom drag coefficient (default: NO selection) 117 115 !----------------------------------------------------------------------- 118 ln_ OFF = .true. ! free-slip : Cd = 0116 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 119 117 / 120 118 !!====================================================================== … … 133 131 !----------------------------------------------------------------------- 134 132 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 135 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS133 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 136 134 rn_a0 = 0.28 ! thermal expension coefficient (for simplified equation of state) 137 135 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/EXPREF/namelist_cfg
r12511 r13540 99 99 !! !! 100 100 !! namdrg top/bottom drag coefficient (default: NO selection) 101 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)102 !! namdrg_bot bottom friction (ln_ OFF=F)101 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 102 !! namdrg_bot bottom friction (ln_drg_OFF=F) 103 103 !! nambbc bottom temperature boundary condition (default: OFF) 104 104 !! nambbl bottom boundary layer scheme (default: OFF) … … 108 108 &namdrg ! top/bottom drag coefficient (default: NO selection) 109 109 !----------------------------------------------------------------------- 110 ln_ OFF = .true. ! free-slip : Cd = 0110 ln_drg_OFF = .true. ! free-slip : Cd = 0 (F => fill namdrg_bot 111 111 / 112 112 !!====================================================================== … … 125 125 !----------------------------------------------------------------------- 126 126 ln_seos = .true. ! = Use simplified equation of state (S-EOS) 127 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS127 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 128 128 rn_a0 = 0.28 ! thermal expension coefficient (for simplified equation of state) 129 129 rn_b0 = 0. ! saline expension coefficient (for simplified equation of state) -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/MY_SRC/domvvl.F90
r12511 r13540 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 11 12 !!---------------------------------------------------------------------- 12 13 13 !!----------------------------------------------------------------------14 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness15 !! dom_vvl_sf_nxt : Compute next vertical scale factors16 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid17 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another18 !! dom_vvl_rst : read/write restart file19 !! dom_vvl_ctl : Check the vvl options20 !!----------------------------------------------------------------------21 14 USE oce ! ocean dynamics and tracers 22 15 USE phycst ! physical constant … … 36 29 PRIVATE 37 30 38 PUBLIC dom_vvl_init ! called by domain.F9039 PUBLIC dom_vvl_zgr ! called by isfcpl.F9040 PUBLIC dom_vvl_sf_nxt ! called by step.F9041 PUBLIC dom_vvl_sf_update ! called by step.F9042 PUBLIC dom_vvl_interpol ! called by dynnxt.F9043 44 31 ! !!* Namelist nam_vvl 45 32 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate … … 63 50 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 64 51 52 #if defined key_qco 53 !!---------------------------------------------------------------------- 54 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 55 !!---------------------------------------------------------------------- 56 #else 57 !!---------------------------------------------------------------------- 58 !! Default key Old management of time varying vertical coordinate 59 !!---------------------------------------------------------------------- 60 61 !!---------------------------------------------------------------------- 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness 63 !! dom_vvl_sf_nxt : Compute next vertical scale factors 64 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 65 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 66 !! dom_vvl_rst : read/write restart file 67 !! dom_vvl_ctl : Check the vvl options 68 !!---------------------------------------------------------------------- 69 70 PUBLIC dom_vvl_init ! called by domain.F90 71 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 72 PUBLIC dom_vvl_sf_nxt ! called by step.F90 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 76 !! * Substitutions 77 # include "do_loop_substitute.h90" 65 78 !!---------------------------------------------------------------------- 66 79 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 133 146 ! 134 147 END SUBROUTINE dom_vvl_init 135 ! 148 149 136 150 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 137 151 !!---------------------------------------------------------------------- … … 188 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 189 203 gdepw(:,:,1,Kbb) = 0.0_wp 190 DO jk = 2, jpk ! vertical sum 191 DO jj = 1,jpj 192 DO ji = 1,jpi 193 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 194 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 195 ! ! 0.5 where jk = mikt 204 DO_3D( 1, 1, 1, 1, 2, jpk ) 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 207 ! ! 0.5 where jk = mikt 196 208 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 197 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 198 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 199 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 200 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 201 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 202 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 203 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 204 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 205 END DO 206 END DO 207 END DO 209 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 210 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 211 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 212 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 213 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 214 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 215 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 216 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 217 END_3D 208 218 ! 209 219 ! !== thickness of the water column !! (ocean portion only) … … 240 250 ENDIF 241 251 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 242 DO jj = 1, jpj 243 DO ji = 1, jpi 252 DO_2D( 1, 1, 1, 1 ) 244 253 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 245 IF( ABS(gphit(ji,jj)) >= 6.) THEN 246 ! values outside the equatorial band and transition zone (ztilde) 247 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 248 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 249 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 250 ! values inside the equatorial band (ztilde as zstar) 251 frq_rst_e3t(ji,jj) = 0.0_wp 252 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 253 ELSE ! transition band (2.5 to 6 degrees N/S) 254 ! ! (linearly transition from z-tilde to z-star) 255 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 256 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 257 & * 180._wp / 3.5_wp ) ) 258 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 259 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 260 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 261 & * 180._wp / 3.5_wp ) ) 262 ENDIF 263 END DO 264 END DO 254 IF( ABS(gphit(ji,jj)) >= 6.) THEN 255 ! values outside the equatorial band and transition zone (ztilde) 256 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 257 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 258 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 259 ! values inside the equatorial band (ztilde as zstar) 260 frq_rst_e3t(ji,jj) = 0.0_wp 261 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 262 ELSE ! transition band (2.5 to 6 degrees N/S) 263 ! ! (linearly transition from z-tilde to z-star) 264 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 265 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 266 & * 180._wp / 3.5_wp ) ) 267 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 268 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 269 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 270 & * 180._wp / 3.5_wp ) ) 271 ENDIF 272 END_2D 265 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 266 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 267 ii0 = 103 ; ii1 = 111268 ij0 = 128 ; ij1 = 135 ;275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 269 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 270 278 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 326 334 LOGICAL :: ll_do_bclinic ! local logical 327 335 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 328 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 336 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3t 337 LOGICAL , DIMENSION(:,:,:), ALLOCATABLE :: llmsk 329 338 !!---------------------------------------------------------------------- 330 339 ! … … 357 366 END DO 358 367 ! 359 IF( ln_vvl_ztilde .OR. ln_vvl_layer.AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate !360 ! ! ------baroclinic part------ !368 IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 369 ! ! ------baroclinic part------ ! 361 370 ! I - initialization 362 371 ! ================== … … 411 420 zwu(:,:) = 0._wp 412 421 zwv(:,:) = 0._wp 413 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 414 DO jj = 1, jpjm1 415 DO ji = 1, jpim1 ! vector opt. 416 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 417 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 418 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 419 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 420 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 421 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 422 END DO 423 END DO 424 END DO 425 DO jj = 1, jpj ! b - correction for last oceanic u-v points 426 DO ji = 1, jpi 427 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 428 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 429 END DO 430 END DO 431 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 432 DO jj = 2, jpjm1 433 DO ji = 2, jpim1 ! vector opt. 434 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 435 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 436 & ) * r1_e1e2t(ji,jj) 437 END DO 438 END DO 439 END DO 422 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 423 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 424 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 425 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 426 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 427 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 428 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 429 END_3D 430 DO_2D( 1, 1, 1, 1 ) 431 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 432 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 433 END_2D 434 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 435 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 436 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 437 & ) * r1_e1e2t(ji,jj) 438 END_3D 440 439 ! ! d - thickness diffusion transport: boundary conditions 441 440 ! (stored for tracer advction and continuity equation) … … 444 443 ! 4 - Time stepping of baroclinic scale factors 445 444 ! --------------------------------------------- 446 ! Leapfrog time stepping447 ! ~~~~~~~~~~~~~~~~~~~~~~448 445 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 449 446 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) … … 451 448 ! Maximum deformation control 452 449 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 453 ze3t(:,:,jpk) = 0._wp 454 DO jk = 1, jpkm1 455 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 456 END DO 457 z_tmax = MAXVAL( ze3t(:,:,:) ) 458 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 459 z_tmin = MINVAL( ze3t(:,:,:) ) 460 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 450 ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 451 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 452 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 453 END_3D 454 ! 455 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 456 llmsk(Nie1: jpi,:,:) = .FALSE. 457 llmsk(:, 1:Njs1,:) = .FALSE. 458 llmsk(:,Nje1: jpj,:) = .FALSE. 459 ! 460 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 461 z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 462 z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 461 463 ! - ML - test: for the moment, stop simulation for too large e3_t variations 462 464 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 463 IF( lk_mpp ) THEN 464 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 465 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 466 ELSE 467 ijk_max = MAXLOC( ze3t(:,:,:) ) 468 ijk_max(1) = ijk_max(1) + nimpp - 1 469 ijk_max(2) = ijk_max(2) + njmpp - 1 470 ijk_min = MINLOC( ze3t(:,:,:) ) 471 ijk_min(1) = ijk_min(1) + nimpp - 1 472 ijk_min(2) = ijk_min(2) + njmpp - 1 473 ENDIF 465 CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 466 CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 474 467 IF (lwp) THEN 475 468 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax … … 480 473 ENDIF 481 474 ENDIF 475 DEALLOCATE( ze3t, llmsk ) 482 476 ! - ML - end test 483 477 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below … … 646 640 ! Horizontal scale factor interpolations 647 641 ! -------------------------------------- 648 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are al lready computed in dynnxt642 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 649 643 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 650 644 … … 663 657 gdepw(:,:,1,Kmm) = 0.0_wp 664 658 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 665 DO jk = 2, jpk 666 DO jj = 1,jpj 667 DO ji = 1,jpi 668 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 669 ! 1 for jk = mikt 670 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 671 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 672 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 673 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 674 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 675 END DO 676 END DO 677 END DO 659 DO_3D( 1, 1, 1, 1, 2, jpk ) 660 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 661 ! 1 for jk = mikt 662 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 663 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 664 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 665 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 666 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 667 END_3D 678 668 679 669 ! Local depth and Inverse of the local depth of the water … … 722 712 ! 723 713 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 724 DO jk = 1, jpk 725 DO jj = 1, jpjm1 726 DO ji = 1, jpim1 ! vector opt. 727 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 728 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 729 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 730 END DO 731 END DO 732 END DO 714 DO_3D( 1, 0, 1, 0, 1, jpk ) 715 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 716 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 717 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 718 END_3D 733 719 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 734 720 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 735 721 ! 736 722 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 737 DO jk = 1, jpk 738 DO jj = 1, jpjm1 739 DO ji = 1, jpim1 ! vector opt. 740 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 741 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 742 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 743 END DO 744 END DO 745 END DO 723 DO_3D( 1, 0, 1, 0, 1, jpk ) 724 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 725 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 726 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 727 END_3D 746 728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 747 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 748 730 ! 749 731 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 750 DO jk = 1, jpk 751 DO jj = 1, jpjm1 752 DO ji = 1, jpim1 ! vector opt. 753 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 754 & * r1_e1e2f(ji,jj) & 755 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 756 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 757 END DO 758 END DO 759 END DO 732 DO_3D( 1, 0, 1, 0, 1, jpk ) 733 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 734 & * r1_e1e2f(ji,jj) & 735 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 736 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 737 END_3D 760 738 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 761 739 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) … … 825 803 IF( ln_rstart ) THEN !* Read the restart file 826 804 CALL rst_read_open ! open the restart file if necessary 827 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 828 806 ! 829 807 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 832 810 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 833 811 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 812 ! 834 813 ! ! --------- ! 835 814 ! ! all cases ! 836 815 ! ! --------- ! 816 ! 837 817 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 838 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )839 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 840 820 ! needed to restart if land processor not computed 841 821 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 850 830 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 851 831 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 852 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'853 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )832 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 854 834 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 855 835 l_1st_euler = .true. … … 857 837 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 858 838 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 859 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'860 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )839 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 861 841 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 862 842 l_1st_euler = .true. … … 864 844 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 865 845 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 866 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'846 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 867 847 DO jk = 1, jpk 868 848 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 883 863 ! ! ----------------------- ! 884 864 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 885 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios )886 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios )865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 887 867 ELSE ! one at least array is missing 888 868 tilde_e3t_b(:,:,:) = 0.0_wp … … 893 873 ! ! ------------ ! 894 874 IF( id5 > 0 ) THEN ! required array exists 895 CALL iom_get( numror, jpdom_auto glo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios )875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 896 876 ELSE ! array is missing 897 877 hdiv_lf(:,:,:) = 0.0_wp … … 917 897 ssh(:,:,Kbb) = -ssh_ref 918 898 919 DO jj = 1, jpj 920 DO ji = 1, jpi 921 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 922 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 923 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 924 ENDIF 925 ENDDO 926 ENDDO 899 DO_2D( 1, 1, 1, 1 ) 900 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 901 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 902 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 903 ENDIF 904 END_2D 927 905 ENDIF !If test case else 928 906 … … 935 913 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 936 914 937 DO ji = 1, jpi 938 DO jj = 1, jpj 939 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 940 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 941 ENDIF 942 END DO 943 END DO 915 DO_2D( 1, 1, 1, 1 ) 916 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 917 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 918 ENDIF 919 END_2D 944 920 ! 945 921 ELSE … … 1064 1040 END SUBROUTINE dom_vvl_ctl 1065 1041 1042 #endif 1043 1066 1044 !!====================================================================== 1067 1045 END MODULE domvvl -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/MY_SRC/usrdef_hgr.F90
r10074 r13540 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 61 63 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 62 64 ! 63 INTEGER :: ji, jj ! dummy loop indices65 INTEGER :: ji, jj ! dummy loop indices 64 66 REAL(wp) :: zphi0, zlam0, zbeta, zf0 65 REAL(wp) :: zti, z ui, ztj, zvj ! local scalars67 REAL(wp) :: zti, ztj ! local scalars 66 68 !!------------------------------------------------------------------------------- 67 69 ! … … 75 77 ! Position coordinates (in kilometers) 76 78 ! ========== 77 zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 78 zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 79 79 #if defined key_agrif 80 IF( Agrif_Root() ) THEN 81 #endif 82 ! Compatibility WITH old version: 83 ! jperio = 0 => Ni0glo = jpigo_old_version 84 ! => jpiglo-1 replaced by Ni0glo-1 85 zlam0 = -REAL( (Ni0glo-1)/2, wp) * 1.e-3 * rn_dx 86 zphi0 = -REAL( (Nj0glo-1)/2, wp) * 1.e-3 * rn_dy 80 87 #if defined key_agrif 81 ! ! let lower left longitude and latitude from parent 82 IF (.NOT.Agrif_root()) THEN 83 zlam0 = (0.5_wp-(Agrif_parent(jpiglo)-1)/2)*1.e-3*Agrif_irhox()*rn_dx & 84 &+(Agrif_Ix()+nbghostcells-1)*Agrif_irhox()*rn_dx*1.e-3-(0.5_wp+nbghostcells)*rn_dx*1.e-3 85 zphi0 = (0.5_wp-(Agrif_parent(jpjglo)-1)/2)*1.e-3*Agrif_irhoy()*rn_dy & 86 &+(Agrif_Iy()+nbghostcells-1)*Agrif_irhoy()*rn_dy*1.e-3-(0.5_wp+nbghostcells)*rn_dy*1.e-3 88 ELSE 89 ! ! let lower left longitude and latitude from parent 90 ! Compatibility WITH old version: 91 ! jperio = 0 => Ni0glo = jpigo_old_version 92 ! => Agrif_parent(jpiglo)-1 replaced by Agrif_parent(Ni0glo)-1 93 zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx & 94 & + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 95 zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy & 96 & + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 87 97 ENDIF 88 98 #endif 89 99 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 100 DO_2D( 1, 1, 1, 1 ) 101 zti = REAL( mig0_oldcmp(ji) - 1, wp ) ! start at i=0 in the global grid without halos 102 ztj = REAL( mjg0_oldcmp(jj) - 1, wp ) ! start at j=0 in the global grid without halos 103 104 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 105 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 106 plamv(ji,jj) = plamt(ji,jj) 107 plamf(ji,jj) = plamu(ji,jj) 108 109 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 110 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 111 pphiu(ji,jj) = pphit(ji,jj) 112 pphif(ji,jj) = pphiv(ji,jj) 113 END_2D 106 114 ! 107 115 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/MY_SRC/usrdef_istate.F90
r12511 r13540 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 73 75 ! Sea level: 74 76 za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 75 DO ji=1, jpi 76 DO jj=1, jpj 77 zx = glamt(ji,jj) * 1.e3 78 zy = gphit(ji,jj) * 1.e3 79 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 80 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 81 END DO 82 END DO 77 DO_2D( 1, 1, 1, 1 ) 78 zx = glamt(ji,jj) * 1.e3 79 zy = gphit(ji,jj) * 1.e3 80 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 81 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 82 END_2D 83 83 ! 84 84 ! temperature: 85 DO ji=1, jpi 86 DO jj=1, jpj 87 zx = glamt(ji,jj) * 1.e3 88 zy = gphit(ji,jj) * 1.e3 89 DO jk=1,jpk 90 zdt = pdept(ji,jj,jk) 91 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 92 IF (zdt < zH) THEN 93 zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 94 & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + exp(-zH))); 95 ENDIF 96 pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 97 END DO 85 DO_2D( 1, 1, 1, 1 ) 86 zx = glamt(ji,jj) * 1.e3 87 zy = gphit(ji,jj) * 1.e3 88 DO jk=1,jpk 89 zdt = pdept(ji,jj,jk) 90 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 91 IF (zdt < zH) THEN 92 zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 93 & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + EXP(-zH))); 94 ENDIF 95 pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 98 96 END DO 99 END DO97 END_2D 100 98 ! 101 99 ! salinity: … … 104 102 ! velocities: 105 103 za = 2._wp * zP0 / (zf0 * rho0 * zlambda**2) 106 DO ji=1, jpim1 107 DO jj=1, jpj 108 zx = glamu(ji,jj) * 1.e3 109 zy = gphiu(ji,jj) * 1.e3 110 DO jk=1, jpk 111 zdu = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji+1,jj,jk)) 112 IF (zdu < zH) THEN 113 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 114 pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 115 ELSE 116 pu(ji,jj,jk) = 0._wp 117 ENDIF 118 END DO 104 DO_2D( 0, 0, 0, 0 ) 105 zx = glamu(ji,jj) * 1.e3 106 zy = gphiu(ji,jj) * 1.e3 107 DO jk=1, jpk 108 zdu = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji+1,jj,jk)) 109 IF (zdu < zH) THEN 110 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 111 pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 112 ELSE 113 pu(ji,jj,jk) = 0._wp 114 ENDIF 119 115 END DO 120 END DO116 END_2D 121 117 ! 122 DO ji=1, jpi 123 DO jj=1, jpjm1 124 zx = glamv(ji,jj) * 1.e3 125 zy = gphiv(ji,jj) * 1.e3 126 DO jk=1, jpk 127 zdv = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji,jj+1,jk)) 128 IF (zdv < zH) THEN 129 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 130 pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 131 ELSE 132 pv(ji,jj,jk) = 0._wp 133 ENDIF 134 END DO 118 DO_2D( 0, 0, 0, 0 ) 119 zx = glamv(ji,jj) * 1.e3 120 zy = gphiv(ji,jj) * 1.e3 121 DO jk=1, jpk 122 zdv = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji,jj+1,jk)) 123 IF (zdv < zH) THEN 124 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 125 pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 126 ELSE 127 pv(ji,jj,jk) = 0._wp 128 ENDIF 135 129 END DO 136 END DO 137 138 CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 139 CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 130 END_2D 131 ! 132 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 140 133 ! 141 134 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain16 USE dom_oce 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants … … 84 84 kpi = NINT( 1800.e3 / rn_dx ) + 3 85 85 kpj = NINT( 1800.e3 / rn_dy ) + 3 86 ELSE 87 kpi = nbcellsx + 2 + 2*nbghostcells 88 kpj = nbcellsy + 2 + 2*nbghostcells 86 ELSE ! Global Domain size: add nbghostcells + 1 "land" point on each side 87 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) 88 kpj = nbcellsy + 2 * ( nbghostcells + 1 ) 89 !!$ kpi = nbcellsx + nbghostcells_x + nbghostcells_x + 2 90 !!$ kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 89 91 ENDIF 90 92 kpk = NINT( 5000._wp / rn_dz ) + 1 … … 104 106 WRITE(numout,*) ' horizontal resolution rn_dy = ', rn_dy, ' m' 105 107 WRITE(numout,*) ' vertical resolution rn_dz = ', rn_dz, ' m' 108 WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi 109 WRITE(numout,*) ' Nj0glo = ', kpj 110 WRITE(numout,*) ' jpkglo = ', kpk 106 111 WRITE(numout,*) ' VORTEX domain: ' 107 112 WRITE(numout,*) ' LX [km]: ', zlx -
NEMO/branches/2020/r12377_ticket2386/tests/VORTEX/MY_SRC/usrdef_zgr.F90
r12377 r13540 192 192 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 193 193 ! 194 k_bot(:,:) = INT( z2d(:,:) )! =jpkm1 over the ocean point, =0 elsewhere194 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 195 195 ! 196 196 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/EXPREF/context_nemo.xml
r12276 r13540 11 11 <variable id="ref_month" type="int"> 01 </variable> 12 12 <variable id="ref_day" type="int"> 01 </variable> 13 <variable id="r au0" type="float" > 1026.0 </variable>13 <variable id="rho0" type="float" > 1026.0 </variable> 14 14 <variable id="cpocean" type="float" > 3991.86795711963 </variable> 15 15 <variable id="convSpsu" type="float" > 0.99530670233846 </variable> -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/EXPREF/namelist_cfg
r12511 r13540 200 200 !! !! 201 201 !! namdrg top/bottom drag coefficient (default: NO selection) 202 !! namdrg_top top friction (ln_ OFF=F & ln_isfcav=T)203 !! namdrg_bot bottom friction (ln_ OFF=F)202 !! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T) 203 !! namdrg_bot bottom friction (ln_drg_OFF=F) 204 204 !! nambbc bottom temperature boundary condition (default: OFF) 205 205 !! nambbl bottom boundary layer scheme (default: OFF) … … 253 253 ! 254 254 ! ! S-EOS coefficients (ln_seos=T): 255 ! ! rd(T,S,Z)*r au0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS255 ! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 256 256 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 257 257 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) … … 263 263 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 264 264 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 265 !!org caution now a0 = alpha / r au0 with rau0 = 1026265 !!org caution now a0 = alpha / rho0 with rho0 = 1026 266 266 / 267 267 !----------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/MY_SRC/usrdef_hgr.F90
r10074 r13540 13 13 !! usr_def_hgr : initialize the horizontal mesh for WAD_TEST_CASES configuration 14 14 !!---------------------------------------------------------------------- 15 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain15 USE dom_oce 16 16 USE par_oce ! ocean space and time domain 17 17 USE phycst ! physical constants … … 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D( 1, 1, 1, 1 ) 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( mig0_oldcmp(ji)-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( mjg0_oldcmp(jj)-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/MY_SRC/usrdef_istate.F90
r10074 r13540 26 26 PUBLIC usr_def_istate ! called in istate.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 174 176 ! Apply minimum wetdepth criterion 175 177 ! 176 do jj = 1,jpj 177 do ji = 1,jpi 178 IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 179 pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 180 ENDIF 181 end do 182 end do 178 DO_2D( 1, 1, 1, 1 ) 179 IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 180 pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 181 ENDIF 182 END_2D 183 183 ! 184 184 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/MY_SRC/usrdef_nam.F90
r12377 r13540 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain17 16 USE par_oce ! ocean space and time domain 18 17 USE phycst ! physical constants … … 77 76 ! ! Set the lateral boundary condition of the global domain 78 77 kperio = 0 ! WAD_TEST_CASES configuration : closed domain 79 IF( nn_wad_test == 8 ) kperio = 7 ! North-South cyclic test 78 IF( nn_wad_test == 8 ) THEN 79 kperio = 7 ! North-South cyclic test 80 kpi = kpi - 2 ! no closed boundary 81 kpj = kpj - 2 ! no closed boundary 82 ENDIF 80 83 ! 81 84 ! ! control print -
NEMO/branches/2020/r12377_ticket2386/tests/WAD/MY_SRC/usrdef_zgr.F90
r12377 r13540 15 15 !!--------------------------------------------------------------------- 16 16 USE oce ! ocean variables 17 USE dom_oce , ONLY: ht_0, mi0, mi1, nimpp, njmpp, & 18 & mj0, mj1, glamt, gphit ! ocean space and time domain 17 USE dom_oce , ONLY: ht_0, mi0, mi1, mj0, mj1, glamt, gphit ! ocean space and time domain 19 18 USE usrdef_nam ! User defined : namelist variables 20 19 USE wet_dry , ONLY: rn_wdmin1, rn_wdmin2, rn_wdld ! Wetting and drying … … 29 28 PUBLIC usr_def_zgr ! called by domzgr.F90 30 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 31 32 !!---------------------------------------------------------------------- 32 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 242 243 ! at v-point: averaging zht 243 244 zhv = 0._wp 244 DO jj = 1, jpjm1245 zhv( :,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) )246 END DO245 DO_2D( 0, 0, 0, 0 ) 246 zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) ) 247 END_2D 247 248 CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points 248 249 DO jj = mj0(1), mj1(1) ! first row of global domain only … … 279 280 ht_0 = zht 280 281 k_bot(:,:) = jpkm1 * k_top(:,:) !* bottom ocean = jpk-1 (here use k_top as a land mask) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 284 k_bot(ji,jj) = 0 285 k_top(ji,jj) = 0 286 ENDIF 287 END DO 288 END DO 282 DO_2D( 1, 1, 1, 1 ) 283 IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 284 k_bot(ji,jj) = 0 285 k_top(ji,jj) = 0 286 ENDIF 287 END_2D 289 288 ! 290 289 ! !* terrain-following coordinate with e3.(k)=cst) 291 290 ! ! OVERFLOW case : identical with j-index (T=V, U=F) 292 DO jj = 1, jpjm1 293 DO ji = 1, jpim1 294 z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 295 DO jk = 1, jpk 296 zwet = MAX( zht(ji,jj), rn_wdmin1 ) 297 pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk , wp ) - 0.5_wp ) 298 pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp ) ) 299 pe3t (ji,jj,jk) = zwet * z1_jpkm1 300 pe3w (ji,jj,jk) = zwet * z1_jpkm1 301 zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 302 pe3u (ji,jj,jk) = zwet * z1_jpkm1 303 pe3uw(ji,jj,jk) = zwet * z1_jpkm1 304 pe3f (ji,jj,jk) = zwet * z1_jpkm1 305 zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 306 pe3v (ji,jj,jk) = zwet * z1_jpkm1 307 pe3vw(ji,jj,jk) = zwet * z1_jpkm1 308 END DO 309 END DO 310 END DO 291 DO_2D( 0, 0, 0, 0 ) 292 z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 293 DO jk = 1, jpk 294 zwet = MAX( zht(ji,jj), rn_wdmin1 ) 295 pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk , wp ) - 0.5_wp ) 296 pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp ) ) 297 pe3t (ji,jj,jk) = zwet * z1_jpkm1 298 pe3w (ji,jj,jk) = zwet * z1_jpkm1 299 zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 300 pe3u (ji,jj,jk) = zwet * z1_jpkm1 301 pe3uw(ji,jj,jk) = zwet * z1_jpkm1 302 pe3f (ji,jj,jk) = zwet * z1_jpkm1 303 zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 304 pe3v (ji,jj,jk) = zwet * z1_jpkm1 305 pe3vw(ji,jj,jk) = zwet * z1_jpkm1 306 END DO 307 END_2D 311 308 CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. ) 312 309 CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. ) -
NEMO/branches/2020/r12377_ticket2386/tests/demo_cfgs.txt
r12377 r13540 11 11 BENCH OCE ICE TOP 12 12 STATION_ASF OCE 13 CPL_OASIS OCE TOP ICE NST
Note: See TracChangeset
for help on using the changeset viewer.