Changeset 11574
- Timestamp:
- 2019-09-19T12:08:31+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/cfgs/SHARED/field_def_nemo-oce.xml
r11573 r11574 27 27 <field id="soce" long_name="salinity" standard_name="sea_water_practical_salinity" unit="1e-3" grid_ref="grid_T_3D"/> 28 28 <field id="soce_e3t" long_name="salinity (thickness weighted)" unit="1e-3" grid_ref="grid_T_3D" > soce * e3t </field > 29 30 <!-- AGRIF sponge --> 31 <field id="fsahm_spt" long_name=" AGRIF t-sponge viscosity coefficient" unit="m2/s" /> 29 32 30 33 <!-- t-eddy viscosity coefficients (ldfdyn) --> … … 361 364 <field id="uoces" long_name="ocean transport along i-axis times salinity (CRS)" unit="1e-3*m/s" grid_ref="grid_U_3D" /> 362 365 366 367 <!-- AGRIF sponge --> 368 <field id="fsaht_spu" long_name=" AGRIF u-sponge diffusivity coefficient" unit="m2/s" /> 369 363 370 <!-- u-eddy diffusivity coefficients (available if ln_traldf_OFF=F) --> 364 371 <field id="ahtu_2d" long_name=" surface u-eddy diffusivity coefficient" unit="m2/s or m4/s" /> … … 415 422 <field id="voces" long_name="ocean transport along j-axis times salinity (CRS)" unit="1e-3*m/s" grid_ref="grid_V_3D" /> 416 423 424 <!-- AGRIF sponge --> 425 <field id="fsaht_spv" long_name=" AGRIF v-sponge diffusivity coefficient" unit="m2/s" /> 426 417 427 <!-- v-eddy diffusivity coefficients (available if ln_traldf_OFF=F) --> 418 428 <field id="ahtv_2d" long_name=" surface v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" /> … … 493 503 494 504 <!-- F grid --> 505 <!-- AGRIF sponge --> 506 <field id="fsahm_spf" long_name=" AGRIF f-sponge viscosity coefficient" unit="m2/s" /> 507 495 508 <!-- f-eddy viscosity coefficients (ldfdyn) --> 496 509 <field id="ahmf_2d" long_name=" surface f-eddy viscosity coefficient" unit="m2/s or m4/s" /> -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/cfgs/SHARED/namelist_ref
r11573 r11574 560 560 &namagrif ! AGRIF zoom ("key_agrif") 561 561 !----------------------------------------------------------------------- 562 ln_agrif_2way = .true. ! activate two nesting 562 563 ln_spc_dyn = .true. ! use 0 as special value for dynamics 563 564 rn_sponge_tra = 2880. ! coefficient for tracer sponge layer [m2/s] -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_all_update.F90
r10069 r11574 1 #define TWO_WAY 2 3 MODULE agrif_all_update 1 MODULE agrif_all_update 4 2 !!====================================================================== 5 3 !! *** MODULE agrif_all_update *** … … 41 39 !! Order of update matters here ! 42 40 !!---------------------------------------------------------------------- 43 # if defined TWO_WAY 44 IF (Agrif_Root()) RETURN 41 IF (( .NOT.ln_agrif_2way ).OR.(Agrif_Root())) RETURN 45 42 ! 46 43 IF (lwp.AND.lk_agrif_debug) Write(*,*) ' --> START AGRIF UPDATE from grid Number',Agrif_Fixed() … … 67 64 ! 68 65 Agrif_UseSpecialValueInUpdate = .FALSE. 69 #endif70 66 END SUBROUTINE agrif_Update_All 71 67 -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_ice_update.F90
r10069 r11574 1 #define TWO_WAY2 !!#undef TWO_WAY3 1 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 4 2 … … 63 61 Agrif_UseSpecialValueInUpdate = .TRUE. 64 62 65 # if defined TWO_WAY66 63 # if ! defined DECAL_FEEDBACK 67 64 CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice ) … … 79 76 ! CALL Agrif_Update_Variable( u_ice_id , locupdate=(/0,1/), procname = update_u_ice ) 80 77 ! CALL Agrif_Update_Variable( v_ice_id , locupdate=(/0,1/), procname = update_v_ice ) 81 # endif82 78 Agrif_SpecialValueFineGrid = 0. 83 79 Agrif_UseSpecialValueInUpdate = .FALSE. -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce.F90
r10425 r11574 21 21 #endif 22 22 ! !!* Namelist namagrif: AGRIF parameters 23 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: 24 INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points) 23 LOGICAL , PUBLIC :: ln_agrif_2way = .TRUE. !: activate two way nesting 24 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: use zeros (.false.) or not (.true.) in 25 !: bdys dynamical fields interpolation 25 26 REAL(wp), PUBLIC :: rn_sponge_tra = 2800. !: sponge coeff. for tracers 26 27 REAL(wp), PUBLIC :: rn_sponge_dyn = 2800. !: sponge coeff. for dynamics 27 28 LOGICAL , PUBLIC :: ln_chk_bathy = .FALSE. !: check of parent bathymetry 28 LOGICAL , PUBLIC :: lk_agrif_clp = .FALSE. !: Force clamped bcs 29 ! !!! OLD namelist names 30 REAL(wp), PUBLIC :: visc_tra !: sponge coeff. for tracers 31 REAL(wp), PUBLIC :: visc_dyn !: sponge coeff. for dynamics 32 29 ! 30 INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points) 33 31 LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator 34 32 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator … … 42 40 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 43 41 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 42 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utint_stage 43 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtint_stage 44 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 46 46 47 47 ! Barotropic arrays used to store open boundary data during time-splitting loop: 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_w, vbdy_w, hbdy_w 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_e, vbdy_e, hbdy_e 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_n, vbdy_n, hbdy_n 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_s, vbdy_s, hbdy_s 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy, vbdy, hbdy 52 49 53 50 … … 82 79 ierr(:) = 0 83 80 ! 84 ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj), & 85 & fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj), & 86 & tabspongedone_tsn(jpi,jpj), & 81 ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj), & 82 & fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj), & 83 & tabspongedone_tsn(jpi,jpj), & 84 & utint_stage(jpi,jpj), vtint_stage(jpi,jpj), & 87 85 # if defined key_top 88 86 & tabspongedone_trn(jpi,jpj), & … … 91 89 & tabspongedone_v (jpi,jpj), STAT = ierr(1) ) 92 90 93 ALLOCATE( ubdy_w(nbghostcells,jpj), vbdy_w(nbghostcells,jpj), hbdy_w(nbghostcells,jpj), & 94 & ubdy_e(nbghostcells,jpj), vbdy_e(nbghostcells,jpj), hbdy_e(nbghostcells,jpj), & 95 & ubdy_n(jpi,nbghostcells), vbdy_n(jpi,nbghostcells), hbdy_n(jpi,nbghostcells), & 96 & ubdy_s(jpi,nbghostcells), vbdy_s(jpi,nbghostcells), hbdy_s(jpi,nbghostcells), STAT = ierr(2) ) 91 ALLOCATE( ubdy(jpi,jpj), vbdy(jpi,jpj), hbdy(jpi,jpj), STAT = ierr(2) ) 97 92 98 93 agrif_oce_alloc = MAXVAL(ierr) -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90
r10068 r11574 37 37 PRIVATE 38 38 39 PUBLIC Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ ssh_ts, Agrif_dta_ts39 PUBLIC Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts 40 40 PUBLIC Agrif_tra, Agrif_avm 41 41 PUBLIC interpun , interpvn … … 43 43 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 44 44 PUBLIC interpe3t, interpumsk, interpvmsk 45 46 INTEGER :: bdy_tinterp = 047 45 48 46 # include "vectopt_loop_substitute.h90" … … 78 76 ! 79 77 INTEGER :: ji, jj, jk ! dummy loop indices 80 INTEGER :: j1, j2, i1, i281 78 INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2 82 79 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb … … 93 90 Agrif_UseSpecialValue = .FALSE. 94 91 ! 95 ! prevent smoothing in ghost cells96 i1 = 1 ; i2 = nlci97 j1 = 1 ; j2 = nlcj98 IF( nbondj == -1 .OR. nbondj == 2 ) j1 = 2 + nbghostcells99 IF( nbondj == +1 .OR. nbondj == 2 ) j2 = nlcj - nbghostcells - 1100 IF( nbondi == -1 .OR. nbondi == 2 ) i1 = 2 + nbghostcells101 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci - nbghostcells - 1102 103 92 ! --- West --- ! 104 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 105 ibdy1 = 2 106 ibdy2 = 1+nbghostcells 107 ! 108 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 109 ua_b(ibdy1:ibdy2,:) = 0._wp 93 ibdy1 = 2 94 ibdy2 = 1+nbghostcells 95 ! 96 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 97 DO ji = mi0(ibdy1), mi1(ibdy2) 98 ua_b(ji,:) = 0._wp 99 110 100 DO jk = 1, jpkm1 111 101 DO jj = 1, jpj 112 ua_b( ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &113 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)114 115 END DO 102 ua_b(ji,jj) = ua_b(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 103 END DO 104 END DO 105 116 106 DO jj = 1, jpj 117 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 118 END DO 119 ENDIF 120 ! 121 IF( .NOT.lk_agrif_clp ) THEN 122 DO jk=1,jpkm1 ! Smooth 123 DO jj=j1,j2 124 ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 125 END DO 126 END DO 127 ENDIF 128 ! 129 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 107 ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 108 END DO 109 END DO 110 ENDIF 111 ! 112 DO ji = mi0(ibdy1), mi1(ibdy2) 113 zub(ji,:) = 0._wp ! Correct transport 130 114 DO jk = 1, jpkm1 131 115 DO jj = 1, jpj 132 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &133 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk)116 zub(ji,jj) = zub(ji,jj) & 117 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk)*umask(ji,jj,jk) 134 118 END DO 135 119 END DO 136 120 DO jj=1,jpj 137 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)121 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 138 122 END DO 139 123 140 124 DO jk = 1, jpkm1 141 125 DO jj = 1, jpj 142 ua( ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &143 & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk)144 145 126 ua(ji,jj,jk) = ( ua(ji,jj,jk) + ua_b(ji,jj)-zub(ji,jj)) * umask(ji,jj,jk) 127 END DO 128 END DO 129 END DO 146 130 147 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 148 zvb(ibdy1:ibdy2,:) = 0._wp 131 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 132 DO ji = mi0(ibdy1), mi1(ibdy2) 133 zvb(ji,:) = 0._wp 149 134 DO jk = 1, jpkm1 150 135 DO jj = 1, jpj 151 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 152 & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 136 zvb(ji,jj) = zvb(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 153 137 END DO 154 138 END DO 155 139 DO jj = 1, jpj 156 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)140 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 157 141 END DO 158 142 DO jk = 1, jpkm1 159 143 DO jj = 1, jpj 160 va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 161 & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 162 END DO 163 END DO 164 ENDIF 165 ! 166 DO jk = 1, jpkm1 ! Mask domain edges 167 DO jj = 1, jpj 168 ua(1,jj,jk) = 0._wp 169 va(1,jj,jk) = 0._wp 170 END DO 171 END DO 144 va(ji,jj,jk) = ( va(ji,jj,jk) + va_b(ji,jj)-zvb(ji,jj))*vmask(ji,jj,jk) 145 END DO 146 END DO 147 END DO 172 148 ENDIF 173 149 174 150 ! --- East --- ! 175 IF( nbondi == 1 .OR. nbondi == 2 ) THEN176 ibdy1 = nlci-1-nbghostcells177 ibdy2 = nlci-2178 !179 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport180 ua_b( ibdy1:ibdy2,:) = 0._wp151 ibdy1 = jpiglo-1-nbghostcells 152 ibdy2 = jpiglo-2 153 ! 154 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 155 DO ji = mi0(ibdy1), mi1(ibdy2) 156 ua_b(ji,:) = 0._wp 181 157 DO jk = 1, jpkm1 182 158 DO jj = 1, jpj 183 ua_b( ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &184 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)159 ua_b(ji,jj) = ua_b(ji,jj) & 160 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 185 161 END DO 186 162 END DO 187 163 DO jj = 1, jpj 188 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 189 END DO 190 ENDIF 191 ! 192 IF( .NOT.lk_agrif_clp ) THEN 193 DO jk=1,jpkm1 ! Smooth 194 DO jj=j1,j2 195 ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 196 END DO 197 END DO 198 ENDIF 199 ! 200 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 164 ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 165 END DO 166 END DO 167 ENDIF 168 ! 169 DO ji = mi0(ibdy1), mi1(ibdy2) 170 zub(ji,:) = 0._wp ! Correct transport 201 171 DO jk = 1, jpkm1 202 172 DO jj = 1, jpj 203 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &204 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)173 zub(ji,jj) = zub(ji,jj) & 174 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 205 175 END DO 206 176 END DO 207 177 DO jj=1,jpj 208 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)178 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 209 179 END DO 210 180 211 181 DO jk = 1, jpkm1 212 182 DO jj = 1, jpj 213 ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) & 214 & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 215 END DO 216 END DO 183 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 184 & + ua_b(ji,jj)-zub(ji,jj))*umask(ji,jj,jk) 185 END DO 186 END DO 187 END DO 217 188 218 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 219 ibdy1 = ibdy1 + 1 220 ibdy2 = ibdy2 + 1 221 zvb(ibdy1:ibdy2,:) = 0._wp 189 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 190 ibdy1 = jpiglo-nbghostcells 191 ibdy2 = jpiglo-1 192 DO ji = mi0(ibdy1), mi1(ibdy2) 193 zvb(ji,:) = 0._wp 222 194 DO jk = 1, jpkm1 223 195 DO jj = 1, jpj 224 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &225 & + e3v_a( ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)196 zvb(ji,jj) = zvb(ji,jj) & 197 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 226 198 END DO 227 199 END DO 228 200 DO jj = 1, jpj 229 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)201 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 230 202 END DO 231 203 DO jk = 1, jpkm1 232 204 DO jj = 1, jpj 233 va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 234 & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 235 END DO 236 END DO 237 ENDIF 238 ! 239 DO jk = 1, jpkm1 ! Mask domain edges 240 DO jj = 1, jpj 241 ua(nlci-1,jj,jk) = 0._wp 242 va(nlci ,jj,jk) = 0._wp 243 END DO 244 END DO 205 va(ji,jj,jk) = ( va(ji,jj,jk) & 206 & + va_b(ji,jj)-zvb(ji,jj)) * vmask(ji,jj,jk) 207 END DO 208 END DO 209 END DO 245 210 ENDIF 246 211 247 212 ! --- South --- ! 248 IF( nbondj == -1 .OR. nbondj == 2 ) THEN249 jbdy1 = 2250 jbdy2 = 1+nbghostcells251 !252 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport253 va_b(:,j bdy1:jbdy2) = 0._wp213 jbdy1 = 2 214 jbdy2 = 1+nbghostcells 215 ! 216 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 217 DO jj = mj0(jbdy1), mj1(jbdy2) 218 va_b(:,jj) = 0._wp 254 219 DO jk = 1, jpkm1 255 220 DO ji = 1, jpi 256 va_b(ji,j bdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &257 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)221 va_b(ji,jj) = va_b(ji,jj) & 222 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 258 223 END DO 259 224 END DO 260 225 DO ji=1,jpi 261 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 262 END DO 263 ENDIF 264 ! 265 IF ( .NOT.lk_agrif_clp ) THEN 266 DO jk = 1, jpkm1 ! Smooth 267 DO ji = i1, i2 268 va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 269 END DO 270 END DO 271 ENDIF 272 ! 273 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 226 va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj) 227 END DO 228 END DO 229 ENDIF 230 ! 231 DO jj = mj0(jbdy1), mj1(jbdy2) 232 zvb(:,jj) = 0._wp ! Correct transport 274 233 DO jk=1,jpkm1 275 234 DO ji=1,jpi 276 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &277 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)235 zvb(ji,jj) = zvb(ji,jj) & 236 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 278 237 END DO 279 238 END DO 280 239 DO ji = 1, jpi 281 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)240 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 282 241 END DO 283 242 284 243 DO jk = 1, jpkm1 285 244 DO ji = 1, jpi 286 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 287 & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 288 END DO 289 END DO 245 va(ji,jj,jk) = ( va(ji,jj,jk) & 246 & + va_b(ji,jj) - zvb(ji,jj) ) * vmask(ji,jj,jk) 247 END DO 248 END DO 249 END DO 290 250 291 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 292 zub(:,jbdy1:jbdy2) = 0._wp 251 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 252 DO jj = mj0(jbdy1), mj1(jbdy2) 253 zub(:,jj) = 0._wp 293 254 DO jk = 1, jpkm1 294 255 DO ji = 1, jpi 295 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &296 & + e3u_a(ji,j bdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)256 zub(ji,jj) = zub(ji,jj) & 257 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 297 258 END DO 298 259 END DO 299 260 DO ji = 1, jpi 300 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)261 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 301 262 END DO 302 263 303 264 DO jk = 1, jpkm1 304 265 DO ji = 1, jpi 305 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 306 & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 307 END DO 308 END DO 309 ENDIF 310 ! 311 DO jk = 1, jpkm1 ! Mask domain edges 312 DO ji = 1, jpi 313 ua(ji,1,jk) = 0._wp 314 va(ji,1,jk) = 0._wp 315 END DO 316 END DO 266 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 267 & + ua_b(ji,jj) - zub(ji,jj) ) * umask(ji,jj,jk) 268 END DO 269 END DO 270 END DO 317 271 ENDIF 318 272 319 273 ! --- North --- ! 320 IF( nbondj == 1 .OR. nbondj == 2 ) THEN321 jbdy1 = nlcj-1-nbghostcells322 jbdy2 = nlcj-2323 !324 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport325 va_b(:,j bdy1:jbdy2) = 0._wp274 jbdy1 = jpjglo-1-nbghostcells 275 jbdy2 = jpjglo-2 276 ! 277 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 278 DO jj = mj0(jbdy1), mj1(jbdy2) 279 va_b(:,jj) = 0._wp 326 280 DO jk = 1, jpkm1 327 281 DO ji = 1, jpi 328 va_b(ji,j bdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &329 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)282 va_b(ji,jj) = va_b(ji,jj) & 283 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 330 284 END DO 331 285 END DO 332 286 DO ji=1,jpi 333 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 334 END DO 335 ENDIF 336 ! 337 IF ( .NOT.lk_agrif_clp ) THEN 338 DO jk = 1, jpkm1 ! Smooth 339 DO ji = i1, i2 340 va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 341 END DO 342 END DO 343 ENDIF 344 ! 345 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 287 va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj) 288 END DO 289 END DO 290 ENDIF 291 ! 292 DO jj = mj0(jbdy1), mj1(jbdy2) 293 zvb(:,jj) = 0._wp ! Correct transport 346 294 DO jk=1,jpkm1 347 295 DO ji=1,jpi 348 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &349 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)296 zvb(ji,jj) = zvb(ji,jj) & 297 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 350 298 END DO 351 299 END DO 352 300 DO ji = 1, jpi 353 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)301 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 354 302 END DO 355 303 356 304 DO jk = 1, jpkm1 357 305 DO ji = 1, jpi 358 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 359 & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 360 END DO 361 END DO 306 va(ji,jj,jk) = ( va(ji,jj,jk) & 307 & + va_b(ji,jj) - zvb(ji,jj) ) * vmask(ji,jj,jk) 308 END DO 309 END DO 310 END DO 362 311 363 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 364 jbdy1 = jbdy1 + 1 365 jbdy2 = jbdy2 + 1 366 zub(:,jbdy1:jbdy2) = 0._wp 312 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 313 jbdy1 = jpjglo-nbghostcells 314 jbdy2 = jpjglo-1 315 DO jj = mj0(jbdy1), mj1(jbdy2) 316 zub(:,jj) = 0._wp 367 317 DO jk = 1, jpkm1 368 318 DO ji = 1, jpi 369 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &370 & + e3u_a(ji,j bdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)319 zub(ji,jj) = zub(ji,jj) & 320 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 371 321 END DO 372 322 END DO 373 323 DO ji = 1, jpi 374 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)324 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 375 325 END DO 376 326 377 327 DO jk = 1, jpkm1 378 328 DO ji = 1, jpi 379 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 380 & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 381 END DO 382 END DO 383 ENDIF 384 ! 385 DO jk = 1, jpkm1 ! Mask domain edges 386 DO ji = 1, jpi 387 ua(ji,nlcj ,jk) = 0._wp 388 va(ji,nlcj-1,jk) = 0._wp 389 END DO 390 END DO 329 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 330 & + ua_b(ji,jj) - zub(ji,jj) ) * umask(ji,jj,jk) 331 END DO 332 END DO 333 END DO 391 334 ENDIF 392 335 ! … … 401 344 !! 402 345 INTEGER :: ji, jj 346 INTEGER :: istart, iend, jstart, jend 403 347 !!---------------------------------------------------------------------- 404 348 ! 405 349 IF( Agrif_Root() ) RETURN 406 350 ! 407 IF((nbondi == -1).OR.(nbondi == 2)) THEN 351 !--- West ---! 352 istart = 2 353 iend = nbghostcells+1 354 DO ji = mi0(istart), mi1(iend) 408 355 DO jj=1,jpj 409 va_e(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * hvr_e(2:nbghostcells+1,jj) 410 ! Specified fluxes: 411 ua_e(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * hur_e(2:nbghostcells+1,jj) 412 ! Characteristics method (only if ghostcells=1): 413 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 414 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 415 END DO 416 ENDIF 417 ! 418 IF((nbondi == 1).OR.(nbondi == 2)) THEN 356 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 357 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 358 END DO 359 END DO 360 ! 361 !--- East ---! 362 istart = jpiglo-nbghostcells 363 iend = jpiglo-1 364 DO ji = mi0(istart), mi1(iend) 419 365 DO jj=1,jpj 420 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 421 ! Specified fluxes: 422 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 423 ! Characteristics method (only if ghostcells=1): 424 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 425 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 426 END DO 427 ENDIF 428 ! 429 IF((nbondj == -1).OR.(nbondj == 2)) THEN 366 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 367 END DO 368 END DO 369 istart = jpiglo-nbghostcells-1 370 iend = jpiglo-2 371 DO ji = mi0(istart), mi1(iend) 372 DO jj=1,jpj 373 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 374 END DO 375 END DO 376 ! 377 !--- South ---! 378 jstart = 2 379 jend = nbghostcells+1 380 DO jj = mj0(jstart), mj1(jend) 430 381 DO ji=1,jpi 431 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * hur_e(ji,2:nbghostcells+1) 432 ! Specified fluxes: 433 va_e(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * hvr_e(ji,2:nbghostcells+1) 434 ! Characteristics method (only if ghostcells=1): 435 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 436 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 437 END DO 438 ENDIF 439 ! 440 IF((nbondj == 1).OR.(nbondj == 2)) THEN 382 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 383 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 384 END DO 385 END DO 386 ! 387 !--- North ---! 388 jstart = jpjglo-nbghostcells 389 jend = jpjglo-1 390 DO jj = mj0(jstart), mj1(jend) 441 391 DO ji=1,jpi 442 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji,1:nbghostcells) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 443 ! Specified fluxes: 444 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 445 ! Characteristics method (only if ghostcells=1): 446 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 447 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 448 END DO 449 ENDIF 392 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 393 END DO 394 END DO 395 jstart = jpjglo-nbghostcells-1 396 jend = jpjglo-2 397 DO jj = mj0(jstart), mj1(jend) 398 DO ji=1,jpi 399 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 400 END DO 401 END DO 450 402 ! 451 403 END SUBROUTINE Agrif_dyn_ts 452 404 405 SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 406 !!---------------------------------------------------------------------- 407 !! *** ROUTINE Agrif_dyn_ts_flux *** 408 !!---------------------------------------------------------------------- 409 INTEGER, INTENT(in) :: jn 410 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zu, zv 411 !! 412 INTEGER :: ji, jj 413 INTEGER :: istart, iend, jstart, jend 414 !!---------------------------------------------------------------------- 415 ! 416 IF( Agrif_Root() ) RETURN 417 ! 418 !--- West ---! 419 istart = 2 420 iend = nbghostcells+1 421 DO ji = mi0(istart), mi1(iend) 422 DO jj=1,jpj 423 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 424 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 425 END DO 426 END DO 427 ! 428 !--- East ---! 429 istart = jpiglo-nbghostcells 430 iend = jpiglo-1 431 DO ji = mi0(istart), mi1(iend) 432 DO jj=1,jpj 433 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 434 END DO 435 END DO 436 istart = jpiglo-nbghostcells-1 437 iend = jpiglo-2 438 DO ji = mi0(istart), mi1(iend) 439 DO jj=1,jpj 440 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 441 END DO 442 END DO 443 ! 444 !--- South ---! 445 jstart = 2 446 jend = nbghostcells+1 447 DO jj = mj0(jstart), mj1(jend) 448 DO ji=1,jpi 449 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 450 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 451 END DO 452 END DO 453 ! 454 !--- North ---! 455 jstart = jpjglo-nbghostcells 456 jend = jpjglo-1 457 DO jj = mj0(jstart), mj1(jend) 458 DO ji=1,jpi 459 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 460 END DO 461 END DO 462 jstart = jpjglo-nbghostcells-1 463 jend = jpjglo-2 464 DO jj = mj0(jstart), mj1(jend) 465 DO ji=1,jpi 466 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 467 END DO 468 END DO 469 ! 470 END SUBROUTINE Agrif_dyn_ts_flux 453 471 454 472 SUBROUTINE Agrif_dta_ts( kt ) … … 470 488 ! 471 489 ! Interpolate barotropic fluxes 472 Agrif_SpecialValue =0._wp490 Agrif_SpecialValue = 0._wp 473 491 Agrif_UseSpecialValue = ln_spc_dyn 492 ! 493 ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners) 494 utint_stage(:,:) = 0 495 vtint_stage(:,:) = 0 474 496 ! 475 497 IF( ll_int_cons ) THEN ! Conservative interpolation 476 498 ! order matters here !!!!!! 477 499 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 478 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 479 bdy_tinterp = 1500 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 501 ! 480 502 CALL Agrif_Bc_variable( unb_id , calledweight=1._wp, procname=interpunb ) ! After 481 503 CALL Agrif_Bc_variable( vnb_id , calledweight=1._wp, procname=interpvnb ) 482 bdy_tinterp = 2504 ! 483 505 CALL Agrif_Bc_variable( unb_id , calledweight=0._wp, procname=interpunb ) ! Before 484 506 CALL Agrif_Bc_variable( vnb_id , calledweight=0._wp, procname=interpvnb ) 485 507 ELSE ! Linear interpolation 486 bdy_tinterp = 0 487 ubdy_w(:,:) = 0._wp ; vbdy_w(:,:) = 0._wp 488 ubdy_e(:,:) = 0._wp ; vbdy_e(:,:) = 0._wp 489 ubdy_n(:,:) = 0._wp ; vbdy_n(:,:) = 0._wp 490 ubdy_s(:,:) = 0._wp ; vbdy_s(:,:) = 0._wp 508 ! 509 ubdy(:,:) = 0._wp ; vbdy(:,:) = 0._wp 491 510 CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 492 511 CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) … … 503 522 INTEGER, INTENT(in) :: kt 504 523 ! 505 INTEGER :: ji, jj, indx, indy 524 INTEGER :: ji, jj 525 INTEGER :: istart, iend, jstart, jend 506 526 !!---------------------------------------------------------------------- 507 527 ! … … 516 536 ! 517 537 ! --- West --- ! 518 IF((nbondi == -1).OR.(nbondi == 2)) THEN 519 indx = 1+nbghostcells 538 istart = 2 539 iend = 1 + nbghostcells 540 DO ji = mi0(istart), mi1(iend) 520 541 DO jj = 1, jpj 521 DO ji = 2, indx 522 ssha(ji,jj) = hbdy_w(ji-1,jj) 523 ENDDO 542 ssha(ji,jj) = hbdy(ji,jj) 524 543 ENDDO 525 END IF544 ENDDO 526 545 ! 527 546 ! --- East --- ! 528 IF((nbondi == 1).OR.(nbondi == 2)) THEN 529 indx = nlci-nbghostcells 547 istart = jpiglo - nbghostcells 548 iend = jpiglo - 1 549 DO ji = mi0(istart), mi1(iend) 530 550 DO jj = 1, jpj 531 DO ji = indx, nlci-1 532 ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 533 ENDDO 551 ssha(ji,jj) = hbdy(ji,jj) 534 552 ENDDO 535 END IF553 ENDDO 536 554 ! 537 555 ! --- South --- ! 538 IF((nbondj == -1).OR.(nbondj == 2)) THEN 539 indy = 1+nbghostcells 540 DO jj = 2, indy 541 DO ji = 1, jpi 542 ssha(ji,jj) = hbdy_s(ji,jj-1) 543 ENDDO 556 jstart = 2 557 jend = 1 + nbghostcells 558 DO jj = mj0(jstart), mj1(jend) 559 DO ji = 1, jpi 560 ssha(ji,jj) = hbdy(ji,jj) 544 561 ENDDO 545 END IF562 ENDDO 546 563 ! 547 564 ! --- North --- ! 548 IF((nbondj == 1).OR.(nbondj == 2)) THEN 549 indy = nlcj-nbghostcells 550 DO jj = indy, nlcj-1 551 DO ji = 1, jpi 552 ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 553 ENDDO 565 jstart = jpjglo - nbghostcells 566 jend = jpjglo - 1 567 DO jj = mj0(jstart), mj1(jend) 568 DO ji = 1, jpi 569 ssha(ji,jj) = hbdy(ji,jj) 554 570 ENDDO 555 END IF571 ENDDO 556 572 ! 557 573 END SUBROUTINE Agrif_ssh … … 564 580 INTEGER, INTENT(in) :: jn 565 581 !! 566 INTEGER :: ji, jj , indx, indy567 !!----------------------------------------------------------------------568 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2)582 INTEGER :: ji, jj 583 INTEGER :: istart, iend, jstart, jend 584 !!---------------------------------------------------------------------- 569 585 ! 570 586 IF( Agrif_Root() ) RETURN 571 587 ! 572 588 ! --- West --- ! 573 IF((nbondi == -1).OR.(nbondi == 2)) THEN 574 indx = 1+nbghostcells 589 istart = 2 590 iend = 1+nbghostcells 591 DO ji = mi0(istart), mi1(iend) 575 592 DO jj = 1, jpj 576 DO ji = 2, indx 577 ssha_e(ji,jj) = hbdy_w(ji-1,jj) 578 ENDDO 593 ssha_e(ji,jj) = hbdy(ji,jj) 579 594 ENDDO 580 END IF595 ENDDO 581 596 ! 582 597 ! --- East --- ! 583 IF((nbondi == 1).OR.(nbondi == 2)) THEN 584 indx = nlci-nbghostcells 598 istart = jpiglo - nbghostcells 599 iend = jpiglo - 1 600 DO ji = mi0(istart), mi1(iend) 585 601 DO jj = 1, jpj 586 DO ji = indx, nlci-1 587 ssha_e(ji,jj) = hbdy_e(ji-indx+1,jj) 588 ENDDO 602 ssha_e(ji,jj) = hbdy(ji,jj) 589 603 ENDDO 590 END IF604 ENDDO 591 605 ! 592 606 ! --- South --- ! 593 IF((nbondj == -1).OR.(nbondj == 2)) THEN 594 indy = 1+nbghostcells 595 DO jj = 2, indy 596 DO ji = 1, jpi 597 ssha_e(ji,jj) = hbdy_s(ji,jj-1) 598 ENDDO 607 jstart = 2 608 jend = 1+nbghostcells 609 DO jj = mj0(jstart), mj1(jend) 610 DO ji = 1, jpi 611 ssha_e(ji,jj) = hbdy(ji,jj) 599 612 ENDDO 600 END IF613 ENDDO 601 614 ! 602 615 ! --- North --- ! 603 IF((nbondj == 1).OR.(nbondj == 2)) THEN 604 indy = nlcj-nbghostcells 605 DO jj = indy, nlcj-1 606 DO ji = 1, jpi 607 ssha_e(ji,jj) = hbdy_n(ji,jj-indy+1) 608 ENDDO 616 jstart = jpjglo - nbghostcells 617 jend = jpjglo - 1 618 DO jj = mj0(jstart), mj1(jend) 619 DO ji = 1, jpi 620 ssha_e(ji,jj) = hbdy(ji,jj) 609 621 ENDDO 610 END IF622 ENDDO 611 623 ! 612 624 END SUBROUTINE Agrif_ssh_ts … … 634 646 635 647 636 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before , nb, ndir)648 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 637 649 !!---------------------------------------------------------------------- 638 650 !! *** ROUTINE interptsn *** … … 641 653 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 642 654 LOGICAL , INTENT(in ) :: before 643 INTEGER , INTENT(in ) :: nb , ndir 644 ! 645 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 646 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 647 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 648 LOGICAL :: western_side, eastern_side,northern_side,southern_side 655 ! 656 INTEGER :: ji, jj, jk, jn ! dummy loop indices 657 INTEGER :: N_in, N_out 649 658 ! vertical interpolation: 650 659 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child … … 652 661 REAL(wp), DIMENSION(k1:k2) :: h_in 653 662 REAL(wp), DIMENSION(1:jpk) :: h_out 654 REAL(wp) :: h_diff655 663 656 664 IF( before ) THEN … … 676 684 ELSE 677 685 678 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2)679 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2)680 681 686 # if defined key_vertical 682 687 DO jj=j1,j2 683 688 DO ji=i1,i2 684 iref = ji685 jref = jj686 if(western_side) iref=MAX(2,ji)687 if(eastern_side) iref=MIN(nlci-1,ji)688 if(southern_side) jref=MAX(2,jj)689 if(northern_side) jref=MIN(nlcj-1,jj)690 689 N_in = 0 691 690 DO jk=k1,k2 !k2 = jpk of parent grid … … 697 696 N_out = 0 698 697 DO jk=1,jpk ! jpk of child grid 699 IF (tmask( iref,jref,jk) == 0) EXIT698 IF (tmask(ji,jj,jk) == 0) EXIT 700 699 N_out = N_out + 1 701 h_out(jk) = e3t_n( iref,jref,jk)700 h_out(jk) = e3t_n(ji,jj,jk) 702 701 ENDDO 703 702 IF (N_in > 0) THEN … … 716 715 END DO 717 716 718 IF ( .NOT.lk_agrif_clp ) THEN719 !720 imin = i1 ; imax = i2721 jmin = j1 ; jmax = j2722 !723 ! Remove CORNERS724 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells725 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1726 IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells727 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1728 !729 IF( eastern_side ) THEN730 zrho = Agrif_Rhox()731 z1 = ( zrho - 1._wp ) * 0.5_wp732 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )733 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )734 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )735 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7736 !737 ibdy = nlci-nbghostcells738 DO jn = 1, jpts739 tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)740 DO jk = 1, jpkm1741 DO jj = jmin,jmax742 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN743 tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)744 ELSE745 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)746 IF( un(ibdy-1,jj,jk) > 0._wp ) THEN747 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &748 + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)749 ENDIF750 ENDIF751 END DO752 END DO753 ! Restore ghost points:754 tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)755 END DO756 ENDIF757 !758 IF( northern_side ) THEN759 zrho = Agrif_Rhoy()760 z1 = ( zrho - 1._wp ) * 0.5_wp761 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )762 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )763 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )764 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7765 !766 jbdy = nlcj-nbghostcells767 DO jn = 1, jpts768 tsa(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)769 DO jk = 1, jpkm1770 DO ji = imin,imax771 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN772 tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)773 ELSE774 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)775 IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN776 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn) &777 + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)778 ENDIF779 ENDIF780 END DO781 END DO782 ! Restore ghost points:783 tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)784 END DO785 ENDIF786 !787 IF( western_side ) THEN788 zrho = Agrif_Rhox()789 z1 = ( zrho - 1._wp ) * 0.5_wp790 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )791 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )792 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )793 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7794 !795 ibdy = 1+nbghostcells796 DO jn = 1, jpts797 tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)798 DO jk = 1, jpkm1799 DO jj = jmin,jmax800 IF( umask(ibdy,jj,jk) == 0._wp ) THEN801 tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)802 ELSE803 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)804 IF( un(ibdy,jj,jk) < 0._wp ) THEN805 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) &806 + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)807 ENDIF808 ENDIF809 END DO810 END DO811 ! Restore ghost points:812 tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)813 END DO814 ENDIF815 !816 IF( southern_side ) THEN817 zrho = Agrif_Rhoy()818 z1 = ( zrho - 1._wp ) * 0.5_wp819 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )820 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )821 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )822 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7823 !824 jbdy=1+nbghostcells825 DO jn = 1, jpts826 tsa(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)827 DO jk = 1, jpkm1828 DO ji = imin,imax829 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN830 tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)831 ELSE832 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)833 IF( vn(ji,jbdy,jk) < 0._wp ) THEN834 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) &835 + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)836 ENDIF837 ENDIF838 END DO839 END DO840 ! Restore ghost points:841 tsa(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)842 END DO843 ENDIF844 !845 ENDIF846 717 ENDIF 847 718 ! 848 719 END SUBROUTINE interptsn 849 720 850 SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before , nb, ndir)721 SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 851 722 !!---------------------------------------------------------------------- 852 723 !! *** ROUTINE interpsshn *** … … 855 726 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 856 727 LOGICAL , INTENT(in ) :: before 857 INTEGER , INTENT(in ) :: nb , ndir 858 ! 859 LOGICAL :: western_side, eastern_side,northern_side,southern_side 728 ! 860 729 !!---------------------------------------------------------------------- 861 730 ! … … 863 732 ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 864 733 ELSE 865 western_side = (nb == 1).AND.(ndir == 1) 866 eastern_side = (nb == 1).AND.(ndir == 2) 867 southern_side = (nb == 2).AND.(ndir == 1) 868 northern_side = (nb == 2).AND.(ndir == 2) 869 !! clem ghost 870 IF(western_side) hbdy_w(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 871 IF(eastern_side) hbdy_e(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 872 IF(southern_side) hbdy_s(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 873 IF(northern_side) hbdy_n(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 734 hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 874 735 ENDIF 875 736 ! … … 1045 906 END SUBROUTINE interpvn 1046 907 1047 SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before , nb, ndir)908 SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before) 1048 909 !!---------------------------------------------------------------------- 1049 910 !! *** ROUTINE interpunb *** … … 1052 913 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1053 914 LOGICAL , INTENT(in ) :: before 1054 INTEGER , INTENT(in ) :: nb , ndir1055 915 ! 1056 916 INTEGER :: ji, jj 1057 917 REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 1058 LOGICAL :: western_side, eastern_side,northern_side,southern_side1059 918 !!---------------------------------------------------------------------- 1060 919 ! … … 1062 921 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2) 1063 922 ELSE 1064 western_side = (nb == 1).AND.(ndir == 1)1065 eastern_side = (nb == 1).AND.(ndir == 2)1066 southern_side = (nb == 2).AND.(ndir == 1)1067 northern_side = (nb == 2).AND.(ndir == 2)1068 923 zrhoy = Agrif_Rhoy() 1069 924 zrhot = Agrif_rhot() … … 1071 926 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1072 927 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1073 ! Polynomial interpolation coefficients: 1074 IF( bdy_tinterp == 1 ) THEN 1075 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1076 & - zt0**2._wp * ( zt0 - 1._wp) ) 1077 ELSEIF( bdy_tinterp == 2 ) THEN 1078 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1079 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1080 ELSE 1081 ztcoeff = 1 1082 ENDIF 1083 ! 1084 IF(western_side) ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1085 IF(eastern_side) ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1086 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1087 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1088 ! 1089 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1090 IF(western_side) ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1091 IF(eastern_side) ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1092 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1093 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1094 ENDIF 1095 ENDIF 928 ! 929 DO ji = i1, i2 930 DO jj = j1, j2 931 IF ( utint_stage(ji,jj) == 1 ) THEN 932 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 933 & - zt0**2._wp * ( zt0 - 1._wp) ) 934 ELSEIF( utint_stage(ji,jj) == 2 ) THEN 935 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 936 & - zt0 * ( zt0 - 1._wp)**2._wp ) 937 ELSEIF( utint_stage(ji,jj) == 0 ) THEN 938 ztcoeff = 1._wp 939 ELSE 940 ztcoeff = 0._wp 941 ENDIF 942 ! 943 ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj) 944 ! 945 IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN 946 ubdy(ji,jj) = ubdy(ji,jj) / (zrhoy*e2u(ji,jj)) * umask(ji,jj,1) 947 utint_stage(ji,jj) = 3 948 ELSE 949 utint_stage(ji,jj) = utint_stage(ji,jj) + 1 950 ENDIF 951 END DO 952 END DO 953 END IF 1096 954 ! 1097 955 END SUBROUTINE interpunb 1098 956 1099 957 1100 SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before , nb, ndir)958 SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before ) 1101 959 !!---------------------------------------------------------------------- 1102 960 !! *** ROUTINE interpvnb *** … … 1105 963 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1106 964 LOGICAL , INTENT(in ) :: before 1107 INTEGER , INTENT(in ) :: nb , ndir 1108 ! 1109 INTEGER :: ji,jj 965 ! 966 INTEGER :: ji, jj 1110 967 REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff 1111 LOGICAL :: western_side, eastern_side,northern_side,southern_side1112 968 !!---------------------------------------------------------------------- 1113 969 ! … … 1115 971 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2) 1116 972 ELSE 1117 western_side = (nb == 1).AND.(ndir == 1)1118 eastern_side = (nb == 1).AND.(ndir == 2)1119 southern_side = (nb == 2).AND.(ndir == 1)1120 northern_side = (nb == 2).AND.(ndir == 2)1121 973 zrhox = Agrif_Rhox() 1122 974 zrhot = Agrif_rhot() 1123 975 ! Time indexes bounds for integration 1124 976 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1125 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1126 IF( bdy_tinterp == 1 ) THEN 1127 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1128 & - zt0**2._wp * ( zt0 - 1._wp) ) 1129 ELSEIF( bdy_tinterp == 2 ) THEN 1130 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1131 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1132 ELSE 1133 ztcoeff = 1 1134 ENDIF 1135 !! clem ghost 1136 IF(western_side) vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1137 IF(eastern_side) vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1138 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1139 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1140 ! 1141 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1142 IF(western_side) vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1143 IF(eastern_side) vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1144 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1145 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1146 ENDIF 977 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 978 ! 979 DO ji = i1, i2 980 DO jj = j1, j2 981 IF ( vtint_stage(ji,jj) == 1 ) THEN 982 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 983 & - zt0**2._wp * ( zt0 - 1._wp) ) 984 ELSEIF( vtint_stage(ji,jj) == 2 ) THEN 985 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 986 & - zt0 * ( zt0 - 1._wp)**2._wp ) 987 ELSEIF( vtint_stage(ji,jj) == 0 ) THEN 988 ztcoeff = 1._wp 989 ELSE 990 ztcoeff = 0._wp 991 ENDIF 992 ! 993 vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj) 994 ! 995 IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN 996 vbdy(ji,jj) = vbdy(ji,jj) / (zrhox*e1v(ji,jj)) * vmask(ji,jj,1) 997 vtint_stage(ji,jj) = 3 998 ELSE 999 vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1 1000 ENDIF 1001 END DO 1002 END DO 1147 1003 ENDIF 1148 1004 ! … … 1150 1006 1151 1007 1152 SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before , nb, ndir)1008 SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before ) 1153 1009 !!---------------------------------------------------------------------- 1154 1010 !! *** ROUTINE interpub2b *** … … 1157 1013 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1158 1014 LOGICAL , INTENT(in ) :: before 1159 INTEGER , INTENT(in ) :: nb , ndir1160 1015 ! 1161 1016 INTEGER :: ji,jj 1162 REAL(wp) :: zrhot, zt0, zt1,zat 1163 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1017 REAL(wp) :: zrhot, zt0, zt1, zat 1164 1018 !!---------------------------------------------------------------------- 1165 1019 IF( before ) THEN … … 1170 1024 ENDIF 1171 1025 ELSE 1172 western_side = (nb == 1).AND.(ndir == 1)1173 eastern_side = (nb == 1).AND.(ndir == 2)1174 southern_side = (nb == 2).AND.(ndir == 1)1175 northern_side = (nb == 2).AND.(ndir == 2)1176 zrhot = Agrif_rhot()1177 ! Time indexes bounds for integration1178 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot1179 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot1180 ! Polynomial interpolation coefficients:1181 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) &1182 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) )1183 !! clem ghost1184 IF(western_side ) ubdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)1185 IF(eastern_side ) ubdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)1186 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)1187 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)1188 ENDIF1189 !1190 END SUBROUTINE interpub2b1191 1192 1193 SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir )1194 !!----------------------------------------------------------------------1195 !! *** ROUTINE interpvb2b ***1196 !!----------------------------------------------------------------------1197 INTEGER , INTENT(in ) :: i1, i2, j1, j21198 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab1199 LOGICAL , INTENT(in ) :: before1200 INTEGER , INTENT(in ) :: nb , ndir1201 !1202 INTEGER :: ji,jj1203 REAL(wp) :: zrhot, zt0, zt1,zat1204 LOGICAL :: western_side, eastern_side,northern_side,southern_side1205 !!----------------------------------------------------------------------1206 !1207 IF( before ) THEN1208 IF ( ln_bt_fw ) THEN1209 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)1210 ELSE1211 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)1212 ENDIF1213 ELSE1214 western_side = (nb == 1).AND.(ndir == 1)1215 eastern_side = (nb == 1).AND.(ndir == 2)1216 southern_side = (nb == 2).AND.(ndir == 1)1217 northern_side = (nb == 2).AND.(ndir == 2)1218 1026 zrhot = Agrif_rhot() 1219 1027 ! Time indexes bounds for integration … … 1224 1032 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1225 1033 ! 1226 IF(western_side ) vbdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1227 IF(eastern_side ) vbdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1228 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1229 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1034 ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 1035 ! 1036 ! Update interpolation stage: 1037 utint_stage(i1:i2,j1:j2) = 1 1038 ENDIF 1039 ! 1040 END SUBROUTINE interpub2b 1041 1042 1043 SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before ) 1044 !!---------------------------------------------------------------------- 1045 !! *** ROUTINE interpvb2b *** 1046 !!---------------------------------------------------------------------- 1047 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1048 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1049 LOGICAL , INTENT(in ) :: before 1050 ! 1051 INTEGER :: ji,jj 1052 REAL(wp) :: zrhot, zt0, zt1, zat 1053 !!---------------------------------------------------------------------- 1054 ! 1055 IF( before ) THEN 1056 IF ( ln_bt_fw ) THEN 1057 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1058 ELSE 1059 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 1060 ENDIF 1061 ELSE 1062 zrhot = Agrif_rhot() 1063 ! Time indexes bounds for integration 1064 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1065 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1066 ! Polynomial interpolation coefficients: 1067 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1068 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1069 ! 1070 vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 1071 ! 1072 ! update interpolation stage: 1073 vtint_stage(i1:i2,j1:j2) = 1 1230 1074 ENDIF 1231 1075 ! -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_sponge.F90
r10425 r11574 22 22 USE agrif_oce 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE iom 24 25 25 26 IMPLICIT NONE … … 58 59 #endif 59 60 ! 61 CALL iom_put("fsaht_spu", fsaht_spu(:,:)) 62 CALL iom_put("fsaht_spv", fsaht_spv(:,:)) 63 ! 60 64 END SUBROUTINE Agrif_Sponge_Tra 61 65 … … 85 89 #endif 86 90 ! 91 CALL iom_put("fsahm_spt", fsahm_spt(:,:)) 92 CALL iom_put("fsahm_spf", fsahm_spf(:,:)) 93 ! 87 94 END SUBROUTINE Agrif_Sponge_dyn 88 95 … … 93 100 !!---------------------------------------------------------------------- 94 101 INTEGER :: ji, jj, ind1, ind2 95 INTEGER :: ispongearea 96 REAL(wp) :: z1_ spongearea102 INTEGER :: ispongearea, jspongearea 103 REAL(wp) :: z1_ispongearea, z1_jspongearea 97 104 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 105 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 106 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth 98 107 !!---------------------------------------------------------------------- 99 108 ! 100 109 #if defined SPONGE || defined SPONGE_TOP 101 110 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 111 ! 112 ! Retrieve masks at open boundaries: 113 114 ! --- West --- ! 115 ztabramp(:,:) = 0._wp 116 ind1 = 1+nbghostcells 117 DO ji = mi0(ind1), mi1(ind1) 118 ztabramp(ji,:) = umask(ji,:,1) 119 END DO 120 ! 121 zmskwest(:) = 0._wp 122 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 123 124 ! --- East --- ! 125 ztabramp(:,:) = 0._wp 126 ind1 = jpiglo - nbghostcells - 1 127 DO ji = mi0(ind1), mi1(ind1) 128 ztabramp(ji,:) = umask(ji,:,1) 129 END DO 130 ! 131 zmskeast(:) = 0._wp 132 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 133 134 ! --- South --- ! 135 ztabramp(:,:) = 0._wp 136 ind1 = 1+nbghostcells 137 DO jj = mj0(ind1), mj1(ind1) 138 ztabramp(:,jj) = vmask(:,jj,1) 139 END DO 140 ! 141 zmsksouth(:) = 0._wp 142 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 143 144 ! --- North --- ! 145 ztabramp(:,:) = 0._wp 146 ind1 = jpjglo - nbghostcells - 1 147 DO jj = mj0(ind1), mj1(ind1) 148 ztabramp(:,jj) = vmask(:,jj,1) 149 END DO 150 ! 151 zmsknorth(:) = 0._wp 152 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 153 154 #if defined key_mpp_mpi 155 CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 156 CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax ) 157 CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax ) 158 CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax ) 159 #endif 160 102 161 ! Define ramp from boundaries towards domain interior at T-points 103 162 ! Store it in ztabramp 104 163 105 164 ispongearea = 1 + nn_sponge_len * Agrif_irhox() 106 z1_spongearea = 1._wp / REAL( ispongearea ) 165 z1_ispongearea = 1._wp / REAL( ispongearea ) 166 jspongearea = 1 + nn_sponge_len * Agrif_irhoy() 167 z1_jspongearea = 1._wp / REAL( jspongearea ) 107 168 108 169 ztabramp(:,:) = 0._wp 170 IF ( Agrif_irhox()==1 ) ispongearea =-1 171 IF ( Agrif_irhoy()==1 ) jspongearea =-1 109 172 110 173 ! --- West --- ! 111 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 112 ind1 = 1+nbghostcells 113 ind2 = 1+nbghostcells + ispongearea 174 ind1 = 1+nbghostcells 175 ind2 = 1+nbghostcells + ispongearea 176 DO ji = mi0(ind1), mi1(ind2) 177 DO jj = 1, jpj 178 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 179 END DO 180 END DO 181 182 ! ghost cells (cosmetic): 183 ind1 = 1 184 ind2 = nbghostcells 185 DO ji = mi0(ind1), mi1(ind2) 186 DO jj = 1, jpj 187 ztabramp(ji,jj) = zmskwest(jj) 188 END DO 189 END DO 190 191 ! --- East --- ! 192 ind1 = jpiglo - nbghostcells - ispongearea 193 ind2 = jpiglo - nbghostcells 194 DO ji = mi0(ind1), mi1(ind2) 114 195 DO jj = 1, jpj 115 DO ji = ind1, ind2 116 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 117 END DO 196 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 118 197 ENDDO 119 END IF120 121 ! --- East --- !122 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN123 ind1 = nlci - nbghostcells - ispongearea124 ind2 = nlci - nbghostcells198 END DO 199 200 ! ghost cells (cosmetic): 201 ind1 = jpiglo - nbghostcells + 1 202 ind2 = jpiglo 203 DO ji = mi0(ind1), mi1(ind2) 125 204 DO jj = 1, jpj 126 DO ji = ind1, ind2 127 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) ) 128 ENDDO 205 ztabramp(ji,jj) = zmskeast(jj) 129 206 ENDDO 130 END IF207 END DO 131 208 132 209 ! --- South --- ! 133 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 134 ind1 = 1+nbghostcells 135 ind2 = 1+nbghostcells + ispongearea 136 DO jj = ind1, ind2 137 DO ji = 1, jpi 138 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 139 END DO 140 ENDDO 141 ENDIF 210 ind1 = 1+nbghostcells 211 ind2 = 1+nbghostcells + jspongearea 212 DO jj = mj0(ind1), mj1(ind2) 213 DO ji = 1, jpi 214 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 215 END DO 216 END DO 217 218 ! ghost cells (cosmetic): 219 ind1 = 1 220 ind2 = nbghostcells 221 DO jj = mj0(ind1), mj1(ind2) 222 DO ji = 1, jpi 223 ztabramp(ji,jj) = zmsksouth(ji) 224 END DO 225 END DO 142 226 143 227 ! --- North --- ! 144 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 145 ind1 = nlcj - nbghostcells - ispongearea 146 ind2 = nlcj - nbghostcells 147 DO jj = ind1, ind2 148 DO ji = 1, jpi 149 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 150 END DO 151 ENDDO 152 ENDIF 228 ind1 = jpjglo - nbghostcells - jspongearea 229 ind2 = jpjglo - nbghostcells 230 DO jj = mj0(ind1), mj1(ind2) 231 DO ji = 1, jpi 232 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 233 END DO 234 END DO 235 236 ! ghost cells (cosmetic): 237 ind1 = jpjglo - nbghostcells + 1 238 ind2 = jpjglo 239 DO jj = mj0(ind1), mj1(ind2) 240 DO ji = 1, jpi 241 ztabramp(ji,jj) = zmsknorth(ji) 242 END DO 243 END DO 153 244 154 245 ENDIF … … 160 251 DO jj = 2, jpjm1 161 252 DO ji = 2, jpim1 ! vector opt. 162 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) )163 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) )164 END DO 165 END DO 166 CALL lbc_lnk( 'agrif_ oce_sponge', fsaht_spu, 'U', 1. ) ! Lateral boundary conditions167 CALL lbc_lnk( 'agrif_ oce_sponge', fsaht_spv, 'V', 1. )253 fsaht_spu(ji,jj) = 0.5_wp * rn_sponge_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 254 fsaht_spv(ji,jj) = 0.5_wp * rn_sponge_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 255 END DO 256 END DO 257 CALL lbc_lnk( 'agrif_Sponge', fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 258 CALL lbc_lnk( 'agrif_Sponge', fsaht_spv, 'V', 1. ) 168 259 169 260 spongedoneT = .TRUE. … … 176 267 DO jj = 2, jpjm1 177 268 DO ji = 2, jpim1 ! vector opt. 178 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)179 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) &180 & +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) )181 END DO 182 END DO 183 CALL lbc_lnk( 'agrif_ oce_sponge', fsahm_spt, 'T', 1. ) ! Lateral boundary conditions184 CALL lbc_lnk( 'agrif_ oce_sponge', fsahm_spf, 'F', 1. )269 fsahm_spt(ji,jj) = rn_sponge_dyn * ztabramp(ji,jj) 270 fsahm_spf(ji,jj) = 0.25_wp * rn_sponge_dyn * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & 271 & +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) ) 272 END DO 273 END DO 274 CALL lbc_lnk( 'agrif_Sponge', fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 275 CALL lbc_lnk( 'agrif_Sponge', fsahm_spf, 'F', 1. ) 185 276 186 277 spongedoneU = .TRUE. -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90
r11243 r11574 1 #define TWO_WAY /* TWO WAY NESTING */2 1 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 3 2 #undef VOL_REFLUX /* VOLUME REFLUXING*/ … … 46 45 IF (Agrif_Root()) RETURN 47 46 ! 48 #if defined TWO_WAY49 47 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed() 50 48 … … 64 62 Agrif_UseSpecialValueInUpdate = .FALSE. 65 63 ! 66 #endif67 64 ! 68 65 END SUBROUTINE Agrif_Update_Tra … … 75 72 IF (Agrif_Root()) RETURN 76 73 ! 77 #if defined TWO_WAY78 74 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed() 79 75 … … 121 117 # endif 122 118 END IF 123 #endif124 119 ! 125 120 END SUBROUTINE Agrif_Update_Dyn … … 131 126 ! 132 127 IF (Agrif_Root()) RETURN 133 !134 #if defined TWO_WAY135 128 ! 136 129 Agrif_UseSpecialValueInUpdate = .TRUE. … … 157 150 # endif 158 151 ! 159 #endif160 !161 152 END SUBROUTINE Agrif_Update_ssh 162 153 … … 170 161 IF (Agrif_Root()) RETURN 171 162 ! 172 # if defined TWO_WAY173 174 163 Agrif_UseSpecialValueInUpdate = .TRUE. 175 164 Agrif_SpecialValueFineGrid = 0. … … 180 169 181 170 Agrif_UseSpecialValueInUpdate = .FALSE. 182 183 # endif184 171 185 172 END SUBROUTINE Agrif_Update_Tke … … 192 179 ! 193 180 IF (Agrif_Root()) RETURN 194 !195 #if defined TWO_WAY196 181 ! 197 182 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() … … 209 194 CALL dom_vvl_update_UVF 210 195 CALL Agrif_ParentGrid_To_ChildGrid() 211 !212 #endif213 196 ! 214 197 END SUBROUTINE Agrif_Update_vvl -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_interp.F90
r10068 r11574 90 90 ELSE 91 91 92 # if defined key_vertical 92 93 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 93 94 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 94 95 95 # if defined key_vertical96 96 DO jj=j1,j2 97 97 DO ji=i1,i2 … … 130 130 END DO 131 131 132 IF ( .NOT.lk_agrif_clp ) THEN133 !134 imin = i1 ; imax = i2135 jmin = j1 ; jmax = j2136 !137 ! Remove CORNERS138 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells139 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1140 IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells141 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1142 !143 IF( eastern_side ) THEN144 zrho = Agrif_Rhox()145 z1 = ( zrho - 1._wp ) * 0.5_wp146 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )147 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )148 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )149 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7150 !151 ibdy = nlci-nbghostcells152 DO jn = 1, jptra153 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)154 DO jk = 1, jpkm1155 DO jj = jmin,jmax156 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN157 tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)158 ELSE159 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)160 IF( un(ibdy-1,jj,jk) > 0._wp ) THEN161 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) &162 + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)163 ENDIF164 ENDIF165 END DO166 END DO167 ! Restore ghost points:168 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)169 END DO170 ENDIF171 !172 IF( northern_side ) THEN173 zrho = Agrif_Rhoy()174 z1 = ( zrho - 1._wp ) * 0.5_wp175 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )176 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )177 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )178 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7179 !180 jbdy = nlcj-nbghostcells181 DO jn = 1, jptra182 tra(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)183 DO jk = 1, jpkm1184 DO ji = imin,imax185 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN186 tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)187 ELSE188 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)189 IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN190 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn) &191 + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)192 ENDIF193 ENDIF194 END DO195 END DO196 ! Restore ghost points:197 tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)198 END DO199 ENDIF200 !201 IF( western_side ) THEN202 zrho = Agrif_Rhox()203 z1 = ( zrho - 1._wp ) * 0.5_wp204 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )205 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )206 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )207 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7208 !209 ibdy = 1+nbghostcells210 DO jn = 1, jptra211 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)212 DO jk = 1, jpkm1213 DO jj = jmin,jmax214 IF( umask(ibdy,jj,jk) == 0._wp ) THEN215 tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)216 ELSE217 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)218 IF( un(ibdy,jj,jk) < 0._wp ) THEN219 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) &220 + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)221 ENDIF222 ENDIF223 END DO224 END DO225 ! Restore ghost points:226 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)227 END DO228 ENDIF229 !230 IF( southern_side ) THEN231 zrho = Agrif_Rhoy()232 z1 = ( zrho - 1._wp ) * 0.5_wp233 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )234 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )235 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )236 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7237 !238 jbdy=1+nbghostcells239 DO jn = 1, jptra240 tra(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)241 DO jk = 1, jpkm1242 DO ji = imin,imax243 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN244 tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)245 ELSE246 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)247 IF( vn(ji,jbdy,jk) < 0._wp ) THEN248 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) &249 + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)250 ENDIF251 ENDIF252 END DO253 END DO254 ! Restore ghost points:255 tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)256 END DO257 ENDIF258 !259 ENDIF260 261 132 ENDIF 262 133 ! -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_update.F90
r11078 r11574 1 #define TWO_WAY2 1 #undef DECAL_FEEDBACK 3 2 … … 40 39 IF (Agrif_Root()) RETURN 41 40 ! 42 #if defined TWO_WAY43 41 Agrif_UseSpecialValueInUpdate = .TRUE. 44 42 Agrif_SpecialValueFineGrid = 0._wp … … 53 51 ! 54 52 Agrif_UseSpecialValueInUpdate = .FALSE. 55 !56 #endif57 53 ! 58 54 END SUBROUTINE Agrif_Update_Trc -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90
r11573 r11574 6 6 !! Software governed by the CeCILL license (see ./LICENSE) 7 7 !!---------------------------------------------------------------------- 8 SUBROUTINE agrif_user 9 END SUBROUTINE agrif_user 10 11 SUBROUTINE agrif_before_regridding 12 END SUBROUTINE agrif_before_regridding 13 14 SUBROUTINE Agrif_InitWorkspace 15 !!---------------------------------------------------------------------- 16 !! *** ROUTINE Agrif_InitWorkspace *** 17 !!---------------------------------------------------------------------- 18 USE par_oce 19 USE dom_oce 20 USE nemogcm 21 USE mppini 22 !! 23 IMPLICIT NONE 24 !!---------------------------------------------------------------------- 25 ! 26 IF( .NOT. Agrif_Root() ) THEN 27 ! no more static variables 28 !!$! JC: change to allow for different vertical levels 29 !!$! jpk is already set 30 !!$! keep it jpk possibly different from jpkglo which 31 !!$! hold parent grid vertical levels number (set earlier) 32 !!$! jpk = jpkglo 33 ENDIF 34 ! 35 END SUBROUTINE Agrif_InitWorkspace 36 37 38 SUBROUTINE Agrif_InitValues 8 SUBROUTINE agrif_user 9 END SUBROUTINE agrif_user 10 11 SUBROUTINE agrif_before_regridding 12 END SUBROUTINE agrif_before_regridding 13 14 SUBROUTINE Agrif_InitWorkspace 15 END SUBROUTINE Agrif_InitWorkspace 16 17 SUBROUTINE Agrif_InitValues 39 18 !!---------------------------------------------------------------------- 40 19 !! *** ROUTINE Agrif_InitValues *** 41 !! 42 !! ** Purpose :: Declaration of variables to be interpolated 43 !!---------------------------------------------------------------------- 44 USE Agrif_Util 45 USE oce 46 USE dom_oce 47 USE nemogcm 48 USE tradmp 49 USE bdy_oce , ONLY: ln_bdy 50 !! 51 IMPLICIT NONE 52 !!---------------------------------------------------------------------- 53 ! 54 CALL nemo_init !* Initializations of each fine grid 55 56 ! !* Agrif initialization 57 CALL agrif_nemo_init 58 CALL Agrif_InitValues_cont_dom 59 CALL Agrif_InitValues_cont 20 !!---------------------------------------------------------------------- 21 USE nemogcm 22 !!---------------------------------------------------------------------- 23 ! 24 CALL nemo_init !* Initializations of each fine grid 25 ! 26 ! !* Agrif initialization 27 CALL agrif_nemo_init 28 CALL Agrif_InitValues_cont_dom 29 CALL Agrif_InitValues_cont 60 30 # if defined key_top 61 CALL Agrif_InitValues_cont_top31 CALL Agrif_InitValues_cont_top 62 32 # endif 63 33 # if defined key_si3 64 CALL Agrif_InitValues_cont_ice34 CALL Agrif_InitValues_cont_ice 65 35 # endif 66 ! 67 END SUBROUTINE Agrif_initvalues 68 69 70 SUBROUTINE Agrif_InitValues_cont_dom 71 !!---------------------------------------------------------------------- 72 !! *** ROUTINE Agrif_InitValues_cont *** 73 !! 74 !! ** Purpose :: Declaration of variables to be interpolated 75 !!---------------------------------------------------------------------- 76 USE Agrif_Util 77 USE oce 78 USE dom_oce 79 USE nemogcm 80 USE in_out_manager 81 USE agrif_oce_update 82 USE agrif_oce_interp 83 USE agrif_oce_sponge 84 ! 85 IMPLICIT NONE 86 !!---------------------------------------------------------------------- 87 ! 88 ! Declaration of the type of variable which have to be interpolated 89 ! 90 CALL agrif_declare_var_dom 91 ! 92 END SUBROUTINE Agrif_InitValues_cont_dom 93 94 95 SUBROUTINE agrif_declare_var_dom 96 !!---------------------------------------------------------------------- 97 !! *** ROUTINE agrif_declare_var *** 98 !! 99 !! ** Purpose :: Declaration of variables to be interpolated 100 !!---------------------------------------------------------------------- 101 USE agrif_util 102 USE par_oce 103 USE oce 104 ! 105 IMPLICIT NONE 106 ! 107 INTEGER :: ind1, ind2, ind3 36 ! 37 END SUBROUTINE Agrif_initvalues 38 39 SUBROUTINE Agrif_InitValues_cont_dom 40 !!---------------------------------------------------------------------- 41 !! *** ROUTINE Agrif_InitValues_cont_dom *** 42 !!---------------------------------------------------------------------- 43 ! 44 CALL agrif_declare_var_dom 45 ! 46 END SUBROUTINE Agrif_InitValues_cont_dom 47 48 SUBROUTINE agrif_declare_var_dom 49 !!---------------------------------------------------------------------- 50 !! *** ROUTINE agrif_declare_var_dom *** 51 !!---------------------------------------------------------------------- 52 USE par_oce, ONLY: nbghostcells 53 ! 54 IMPLICIT NONE 55 ! 56 INTEGER :: ind1, ind2, ind3 108 57 !!---------------------------------------------------------------------- 109 58 110 59 ! 1. Declaration of the type of variable which have to be interpolated 111 60 !--------------------------------------------------------------------- 112 ind1 = nbghostcells113 ind2 = 1 + nbghostcells114 ind3 = 2 + nbghostcells115 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)116 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)61 ind1 = nbghostcells 62 ind2 = 1 + nbghostcells 63 ind3 = 2 + nbghostcells 64 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 65 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 117 66 118 67 ! 2. Type of interpolation 119 68 !------------------------- 120 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm )121 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear )69 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm ) 70 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear ) 122 71 123 72 ! 3. Location of interpolation 124 73 !----------------------------- 125 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))126 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))74 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 75 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 127 76 128 77 ! 4. Update type 129 78 !--------------- 130 79 # if defined UPD_HIGH 131 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)132 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)80 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 81 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 133 82 #else 134 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)135 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)83 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 84 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 136 85 #endif 137 86 138 END SUBROUTINE agrif_declare_var_dom 139 140 141 SUBROUTINE Agrif_InitValues_cont 87 END SUBROUTINE agrif_declare_var_dom 88 89 SUBROUTINE Agrif_InitValues_cont 142 90 !!---------------------------------------------------------------------- 143 91 !! *** ROUTINE Agrif_InitValues_cont *** 144 !! 145 !! ** Purpose :: Declaration of variables to be interpolated 146 !!---------------------------------------------------------------------- 147 USE agrif_oce_update 148 USE agrif_oce_interp 149 USE agrif_oce_sponge 150 USE Agrif_Util 151 USE oce 152 USE dom_oce 153 USE zdf_oce 154 USE nemogcm 155 ! 156 USE lib_mpp 157 USE in_out_manager 158 ! 159 IMPLICIT NONE 160 ! 161 LOGICAL :: check_namelist 162 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 163 !!---------------------------------------------------------------------- 164 165 ! 1. Declaration of the type of variable which have to be interpolated 166 !--------------------------------------------------------------------- 167 CALL agrif_declare_var 168 169 ! 2. First interpolations of potentially non zero fields 170 !------------------------------------------------------- 171 Agrif_SpecialValue = 0._wp 172 Agrif_UseSpecialValue = .TRUE. 173 CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 174 CALL Agrif_Sponge 175 tabspongedone_tsn = .FALSE. 176 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 177 ! reset tsa to zero 178 tsa(:,:,:,:) = 0. 179 180 Agrif_UseSpecialValue = ln_spc_dyn 181 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 182 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 183 tabspongedone_u = .FALSE. 184 tabspongedone_v = .FALSE. 185 CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 186 tabspongedone_u = .FALSE. 187 tabspongedone_v = .FALSE. 188 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 189 190 Agrif_UseSpecialValue = .TRUE. 191 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 192 hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 193 ssha(:,:) = 0.e0 194 195 IF ( ln_dynspg_ts ) THEN 92 !!---------------------------------------------------------------------- 93 USE agrif_oce 94 USE agrif_oce_interp 95 USE agrif_oce_sponge 96 USE dom_oce 97 USE oce 98 USE lib_mpp 99 ! 100 IMPLICIT NONE 101 ! 102 LOGICAL :: check_namelist 103 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 104 !!---------------------------------------------------------------------- 105 106 ! 1. Declaration of the type of variable which have to be interpolated 107 !--------------------------------------------------------------------- 108 CALL agrif_declare_var 109 110 ! 2. First interpolations of potentially non zero fields 111 !------------------------------------------------------- 112 Agrif_SpecialValue = 0._wp 113 Agrif_UseSpecialValue = .TRUE. 114 CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 115 CALL Agrif_Sponge 116 tabspongedone_tsn = .FALSE. 117 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 118 ! reset tsa to zero 119 tsa(:,:,:,:) = 0._wp 120 196 121 Agrif_UseSpecialValue = ln_spc_dyn 197 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 198 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 199 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 200 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 201 ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0 202 ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0 203 ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0 204 ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0 205 ENDIF 206 207 Agrif_UseSpecialValue = .FALSE. 208 ! reset velocities to zero 209 ua(:,:,:) = 0. 210 va(:,:,:) = 0. 211 212 ! 3. Some controls 213 !----------------- 214 check_namelist = .TRUE. 215 216 IF( check_namelist ) THEN 217 218 ! Check time steps 219 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 220 WRITE(cl_check1,*) NINT(Agrif_Parent(rdt)) 221 WRITE(cl_check2,*) NINT(rdt) 222 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 223 CALL ctl_stop( 'Incompatible time step between ocean grids', & 224 & 'parent grid value : '//cl_check1 , & 225 & 'child grid value : '//cl_check2 , & 226 & 'value on child grid should be changed to : '//cl_check3 ) 227 ENDIF 228 229 ! Check run length 230 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 231 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 232 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 233 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 234 CALL ctl_warn( 'Incompatible run length between grids' , & 235 & 'nit000 on fine grid will be changed to : '//cl_check1, & 236 & 'nitend on fine grid will be changed to : '//cl_check2 ) 237 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 238 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 239 ENDIF 240 241 ! Check free surface scheme 242 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 243 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 244 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 245 WRITE(cl_check2,*) ln_dynspg_ts 246 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 247 WRITE(cl_check4,*) ln_dynspg_exp 248 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 249 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 250 & 'child grid ln_dynspg_ts :'//cl_check2 , & 251 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 252 & 'child grid ln_dynspg_exp :'//cl_check4 , & 253 & 'those logicals should be identical' ) 254 STOP 255 ENDIF 256 257 ! Check if identical linear free surface option 258 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 259 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 260 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 261 WRITE(cl_check2,*) ln_linssh 262 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 263 & 'parent grid ln_linssh :'//cl_check1 , & 264 & 'child grid ln_linssh :'//cl_check2 , & 265 & 'those logicals should be identical' ) 266 STOP 267 ENDIF 268 269 ! check if masks and bathymetries match 270 IF(ln_chk_bathy) THEN 122 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 123 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 124 tabspongedone_u = .FALSE. 125 tabspongedone_v = .FALSE. 126 CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 127 tabspongedone_u = .FALSE. 128 tabspongedone_v = .FALSE. 129 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 130 ua(:,:,:) = 0._wp 131 va(:,:,:) = 0._wp 132 133 Agrif_UseSpecialValue = .TRUE. 134 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 135 hbdy(:,:) = 0._wp 136 ssha(:,:) = 0._wp 137 138 IF ( ln_dynspg_ts ) THEN 139 Agrif_UseSpecialValue = ln_spc_dyn 140 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 141 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 142 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 143 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 144 ubdy(:,:) = 0._wp 145 vbdy(:,:) = 0._wp 146 ENDIF 147 148 Agrif_UseSpecialValue = .FALSE. 149 150 ! 3. Some controls 151 !----------------- 152 check_namelist = .TRUE. 153 154 IF( check_namelist ) THEN 155 156 ! Check time steps 157 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 158 WRITE(cl_check1,*) NINT(Agrif_Parent(rdt)) 159 WRITE(cl_check2,*) NINT(rdt) 160 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 161 CALL ctl_stop( 'Incompatible time step between ocean grids', & 162 & 'parent grid value : '//cl_check1 , & 163 & 'child grid value : '//cl_check2 , & 164 & 'value on child grid should be changed to : '//cl_check3 ) 165 ENDIF 166 167 ! Check run length 168 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 169 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 170 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 171 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 172 CALL ctl_warn( 'Incompatible run length between grids' , & 173 & 'nit000 on fine grid will be changed to : '//cl_check1, & 174 & 'nitend on fine grid will be changed to : '//cl_check2 ) 175 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 176 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 177 ENDIF 178 179 ! Check free surface scheme 180 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 181 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 182 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 183 WRITE(cl_check2,*) ln_dynspg_ts 184 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 185 WRITE(cl_check4,*) ln_dynspg_exp 186 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 187 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 188 & 'child grid ln_dynspg_ts :'//cl_check2 , & 189 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 190 & 'child grid ln_dynspg_exp :'//cl_check4 , & 191 & 'those logicals should be identical' ) 192 STOP 193 ENDIF 194 195 ! Check if identical linear free surface option 196 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 197 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 198 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 199 WRITE(cl_check2,*) ln_linssh 200 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 201 & 'parent grid ln_linssh :'//cl_check1 , & 202 & 'child grid ln_linssh :'//cl_check2 , & 203 & 'those logicals should be identical' ) 204 STOP 205 ENDIF 206 207 ! check if masks and bathymetries match 208 IF(ln_chk_bathy) THEN 209 ! 210 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 211 ! 212 kindic_agr = 0 213 ! check if umask agree with parent along western and eastern boundaries: 214 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 215 ! check if vmask agree with parent along northern and southern boundaries: 216 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 217 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 218 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 219 ! 220 CALL mpp_sum( 'agrif_user', kindic_agr ) 221 IF( kindic_agr /= 0 ) THEN 222 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 223 ELSE 224 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 225 END IF 226 ENDIF 271 227 ! 272 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 273 ! 274 kindic_agr = 0 275 ! check if umask agree with parent along western and eastern boundaries: 276 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 277 ! check if vmask agree with parent along northern and southern boundaries: 278 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 279 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 280 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 281 ! 282 CALL mpp_sum( 'agrif_user', kindic_agr ) 283 IF( kindic_agr /= 0 ) THEN 284 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 285 ELSE 286 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 287 END IF 288 ENDIF 289 ! 290 ENDIF 291 ! 292 END SUBROUTINE Agrif_InitValues_cont 293 294 SUBROUTINE agrif_declare_var 295 !!---------------------------------------------------------------------- 296 !! *** ROUTINE agrif_declarE_var *** 297 !! 298 !! ** Purpose :: Declaration of variables to be interpolated 299 !!---------------------------------------------------------------------- 300 USE agrif_util 301 USE agrif_oce 302 USE par_oce ! ocean parameters 303 USE zdf_oce ! vertical physics 304 USE oce 305 ! 306 IMPLICIT NONE 307 ! 308 INTEGER :: ind1, ind2, ind3 309 !!---------------------------------------------------------------------- 310 311 ! 1. Declaration of the type of variable which have to be interpolated 312 !--------------------------------------------------------------------- 313 ind1 = nbghostcells 314 ind2 = 1 + nbghostcells 315 ind3 = 2 + nbghostcells 228 ENDIF 229 ! 230 END SUBROUTINE Agrif_InitValues_cont 231 232 SUBROUTINE agrif_declare_var 233 !!---------------------------------------------------------------------- 234 !! *** ROUTINE agrif_declare_var *** 235 !!---------------------------------------------------------------------- 236 USE agrif_util 237 USE agrif_oce 238 USE par_oce 239 USE zdf_oce 240 USE oce 241 ! 242 IMPLICIT NONE 243 ! 244 INTEGER :: ind1, ind2, ind3 245 !!---------------------------------------------------------------------- 246 247 ! 1. Declaration of the type of variable which have to be interpolated 248 !--------------------------------------------------------------------- 249 ind1 = nbghostcells 250 ind2 = 1 + nbghostcells 251 ind3 = 2 + nbghostcells 316 252 # if defined key_vertical 317 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)318 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)319 320 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)321 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)322 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)323 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)324 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)325 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)253 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 254 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 255 256 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 257 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 258 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 259 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 260 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 261 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 326 262 # else 327 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)328 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)329 330 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)331 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)332 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)333 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)334 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)335 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)263 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 264 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 265 266 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 267 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 268 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 269 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 270 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 271 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 336 272 # endif 337 273 338 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)339 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)340 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)341 342 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)343 344 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)345 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)346 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)347 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)348 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)349 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)350 351 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)352 353 IF( ln_zdftke.OR.ln_zdfgls ) THEN354 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)355 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)274 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 275 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 276 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 277 278 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 279 280 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 281 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 282 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 283 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 284 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 285 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 286 287 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 288 289 IF( ln_zdftke.OR.ln_zdfgls ) THEN 290 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 291 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 356 292 # if defined key_vertical 357 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)293 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 358 294 # else 359 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)295 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 360 296 # endif 361 ENDIF362 363 ! 2. Type of interpolation364 !-------------------------365 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)366 367 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)368 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)369 370 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)371 372 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)373 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)374 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)375 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)376 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)377 378 379 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)380 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)381 382 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)383 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)384 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)385 386 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )387 388 ! 3. Location of interpolation389 !-----------------------------390 CALL Agrif_Set_bc( tsn_id, (/0,ind1/) )391 CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )392 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )393 394 CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9395 CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )396 CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )397 398 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )399 CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )400 CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )401 CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )402 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )403 404 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west and rhox=3 and ghost=1: column 2 to 6405 CALL Agrif_Set_bc( umsk_id, (/0,0/) )406 CALL Agrif_Set_bc( vmsk_id, (/0,0/) )407 408 409 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )410 411 ! 4. Update type412 !---------------413 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)297 ENDIF 298 299 ! 2. Type of interpolation 300 !------------------------- 301 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 302 303 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 304 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 305 306 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 307 308 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 309 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 310 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 311 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 312 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 313 314 315 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 316 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 317 318 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 319 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 320 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 321 322 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 323 324 ! 3. Location of interpolation 325 !----------------------------- 326 CALL Agrif_Set_bc( tsn_id, (/0,ind1/) ) 327 CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) ) 328 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) ) 329 330 CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 331 CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 332 CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 333 334 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) ) 335 CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) ) 336 CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) ) 337 CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 338 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 339 340 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west and rhox=3 and ghost=1: column 2 to 6 341 CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 342 CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 343 344 345 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 346 347 ! 4. Update type 348 !--------------- 349 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 414 350 415 351 # if defined UPD_HIGH 416 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)417 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)418 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)419 420 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)421 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)422 CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)423 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)424 425 IF( ln_zdftke.OR.ln_zdfgls ) THEN426 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)427 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)428 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)429 ENDIF352 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 353 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 354 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 355 356 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 357 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 358 CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 359 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 360 361 IF( ln_zdftke.OR.ln_zdfgls ) THEN 362 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 363 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 364 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 365 ENDIF 430 366 431 367 #else 432 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)433 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)434 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)435 436 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)437 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)438 CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)439 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)440 441 IF( ln_zdftke.OR.ln_zdfgls ) THEN442 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)443 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)444 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)445 ENDIF368 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 369 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 370 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 371 372 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 373 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 374 CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 375 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 376 377 IF( ln_zdftke.OR.ln_zdfgls ) THEN 378 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 379 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 380 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 381 ENDIF 446 382 447 383 #endif 448 !449 END SUBROUTINE agrif_declare_var384 ! 385 END SUBROUTINE agrif_declare_var 450 386 451 387 #if defined key_si3 … … 453 389 !!---------------------------------------------------------------------- 454 390 !! *** ROUTINE Agrif_InitValues_cont_ice *** 391 !!---------------------------------------------------------------------- 392 USE Agrif_Util 393 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 394 USE ice 395 USE agrif_ice 396 USE in_out_manager 397 USE agrif_ice_interp 398 USE lib_mpp 399 ! 400 IMPLICIT NONE 401 !!---------------------------------------------------------------------- 402 ! 403 ! Declaration of the type of variable which have to be interpolated (parent=>child) 404 !---------------------------------------------------------------------------------- 405 CALL agrif_declare_var_ice 406 407 ! Controls 408 409 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 410 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 411 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 412 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 413 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 414 415 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 416 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN 417 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 418 ENDIF 419 ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 420 !---------------------------------------------------------------------- 421 nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 422 CALL agrif_interp_ice('U') ! interpolation of ice velocities 423 CALL agrif_interp_ice('V') ! interpolation of ice velocities 424 CALL agrif_interp_ice('T') ! interpolation of ice tracers 425 nbstep_ice = 0 426 ! 427 END SUBROUTINE Agrif_InitValues_cont_ice 428 429 SUBROUTINE agrif_declare_var_ice 430 !!---------------------------------------------------------------------- 431 !! *** ROUTINE agrif_declare_var_ice *** 432 !!---------------------------------------------------------------------- 433 USE Agrif_Util 434 USE ice 435 USE par_oce, ONLY : nbghostcells 436 ! 437 IMPLICIT NONE 438 ! 439 INTEGER :: ind1, ind2, ind3 440 !!---------------------------------------------------------------------- 441 ! 442 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 443 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name) 444 ! ex.: position=> 1,1 = not-centered (in i and j) 445 ! 2,2 = centered ( - ) 446 ! index => 1,1 = one ghost line 447 ! 2,2 = two ghost lines 448 !------------------------------------------------------------------------------------- 449 ind1 = nbghostcells 450 ind2 = 1 + nbghostcells 451 ind3 = 2 + nbghostcells 452 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 453 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 454 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 455 456 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 457 !----------------------------------- 458 CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear) 459 CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm ) 460 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 461 462 ! 3. Set location of interpolations 463 !---------------------------------- 464 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 465 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 466 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 467 468 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 469 !-------------------------------------------------- 470 # if defined UPD_HIGH 471 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 472 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 473 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 474 #else 475 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 476 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 477 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 478 #endif 479 480 END SUBROUTINE agrif_declare_var_ice 481 #endif 482 483 484 # if defined key_top 485 SUBROUTINE Agrif_InitValues_cont_top 486 !!---------------------------------------------------------------------- 487 !! *** ROUTINE Agrif_InitValues_cont_top *** 488 !!---------------------------------------------------------------------- 489 USE Agrif_Util 490 USE oce 491 USE dom_oce 492 USE nemogcm 493 USE par_trc 494 USE lib_mpp 495 USE trc 496 USE in_out_manager 497 USE agrif_oce_sponge 498 USE agrif_top_update 499 USE agrif_top_interp 500 USE agrif_top_sponge 455 501 !! 456 !! ** Purpose :: Initialisation of variables to be interpolated for ice 457 !!---------------------------------------------------------------------- 458 USE Agrif_Util 459 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 460 USE ice 461 USE agrif_ice 462 USE in_out_manager 463 USE agrif_ice_interp 464 USE lib_mpp 465 ! 466 IMPLICIT NONE 467 !!---------------------------------------------------------------------- 468 ! 469 ! Declaration of the type of variable which have to be interpolated (parent=>child) 470 !---------------------------------------------------------------------------------- 471 CALL agrif_declare_var_ice 472 473 ! Controls 474 475 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 476 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 477 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 478 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 479 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 480 481 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 482 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN 483 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 484 ENDIF 485 ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 486 !---------------------------------------------------------------------- 487 nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 488 CALL agrif_interp_ice('U') ! interpolation of ice velocities 489 CALL agrif_interp_ice('V') ! interpolation of ice velocities 490 CALL agrif_interp_ice('T') ! interpolation of ice tracers 491 nbstep_ice = 0 492 493 ! 494 END SUBROUTINE Agrif_InitValues_cont_ice 495 496 SUBROUTINE agrif_declare_var_ice 497 !!---------------------------------------------------------------------- 498 !! *** ROUTINE agrif_declare_var_ice *** 499 !! 500 !! ** Purpose :: Declaration of variables to be interpolated for ice 501 !!---------------------------------------------------------------------- 502 USE Agrif_Util 503 USE ice 504 USE par_oce, ONLY : nbghostcells 505 ! 506 IMPLICIT NONE 507 ! 508 INTEGER :: ind1, ind2, ind3 509 !!---------------------------------------------------------------------- 510 ! 511 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 512 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name) 513 ! ex.: position=> 1,1 = not-centered (in i and j) 514 ! 2,2 = centered ( - ) 515 ! index => 1,1 = one ghost line 516 ! 2,2 = two ghost lines 517 !------------------------------------------------------------------------------------- 518 ind1 = nbghostcells 519 ind2 = 1 + nbghostcells 520 ind3 = 2 + nbghostcells 521 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 522 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 523 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 524 525 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 526 !----------------------------------- 527 CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear) 528 CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm ) 529 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 530 531 ! 3. Set location of interpolations 532 !---------------------------------- 533 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 534 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 535 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 536 537 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 538 !-------------------------------------------------- 539 # if defined UPD_HIGH 540 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 541 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 542 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 543 #else 544 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 545 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 546 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 547 #endif 548 549 END SUBROUTINE agrif_declare_var_ice 550 #endif 551 552 553 # if defined key_top 554 SUBROUTINE Agrif_InitValues_cont_top 555 !!---------------------------------------------------------------------- 556 !! *** ROUTINE Agrif_InitValues_cont_top *** 557 !! 558 !! ** Purpose :: Declaration of variables to be interpolated 559 !!---------------------------------------------------------------------- 560 USE Agrif_Util 561 USE oce 562 USE dom_oce 563 USE nemogcm 564 USE par_trc 565 USE lib_mpp 566 USE trc 567 USE in_out_manager 568 USE agrif_oce_sponge 569 USE agrif_top_update 570 USE agrif_top_interp 571 USE agrif_top_sponge 572 !! 573 IMPLICIT NONE 574 ! 575 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 576 LOGICAL :: check_namelist 577 !!---------------------------------------------------------------------- 578 579 580 ! 1. Declaration of the type of variable which have to be interpolated 581 !--------------------------------------------------------------------- 582 CALL agrif_declare_var_top 583 584 ! 2. First interpolations of potentially non zero fields 585 !------------------------------------------------------- 586 Agrif_SpecialValue=0. 587 Agrif_UseSpecialValue = .TRUE. 588 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 589 Agrif_UseSpecialValue = .FALSE. 590 CALL Agrif_Sponge 591 tabspongedone_trn = .FALSE. 592 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 593 ! reset tsa to zero 594 tra(:,:,:,:) = 0. 595 596 597 ! 3. Some controls 598 !----------------- 599 check_namelist = .TRUE. 600 601 IF( check_namelist ) THEN 602 ! Check time steps 502 IMPLICIT NONE 503 ! 504 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 505 LOGICAL :: check_namelist 506 !!---------------------------------------------------------------------- 507 508 ! 1. Declaration of the type of variable which have to be interpolated 509 !--------------------------------------------------------------------- 510 CALL agrif_declare_var_top 511 512 ! 2. First interpolations of potentially non zero fields 513 !------------------------------------------------------- 514 Agrif_SpecialValue=0._wp 515 Agrif_UseSpecialValue = .TRUE. 516 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 517 Agrif_UseSpecialValue = .FALSE. 518 CALL Agrif_Sponge 519 tabspongedone_trn = .FALSE. 520 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 521 ! reset tsa to zero 522 tra(:,:,:,:) = 0._wp 523 524 ! 3. Some controls 525 !----------------- 526 check_namelist = .TRUE. 527 528 IF( check_namelist ) THEN 529 ! Check time steps 603 530 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 604 531 WRITE(cl_check1,*) Agrif_Parent(rdt) … … 630 557 ENDIF 631 558 ! 632 END SUBROUTINE Agrif_InitValues_cont_top633 634 635 SUBROUTINE agrif_declare_var_top559 END SUBROUTINE Agrif_InitValues_cont_top 560 561 562 SUBROUTINE agrif_declare_var_top 636 563 !!---------------------------------------------------------------------- 637 564 !! *** ROUTINE agrif_declare_var_top *** 565 !!---------------------------------------------------------------------- 566 USE agrif_util 567 USE agrif_oce 568 USE dom_oce 569 USE trc 638 570 !! 639 !! ** Purpose :: Declaration of TOP variables to be interpolated 640 !!---------------------------------------------------------------------- 641 USE agrif_util 642 USE agrif_oce 643 USE dom_oce 644 USE trc 645 !! 646 IMPLICIT NONE 647 ! 648 INTEGER :: ind1, ind2, ind3 649 !!---------------------------------------------------------------------- 650 651 ! 1. Declaration of the type of variable which have to be interpolated 652 !--------------------------------------------------------------------- 653 ind1 = nbghostcells 654 ind2 = 1 + nbghostcells 655 ind3 = 2 + nbghostcells 571 IMPLICIT NONE 572 ! 573 INTEGER :: ind1, ind2, ind3 574 !!---------------------------------------------------------------------- 575 576 ! 1. Declaration of the type of variable which have to be interpolated 577 !--------------------------------------------------------------------- 578 ind1 = nbghostcells 579 ind2 = 1 + nbghostcells 580 ind3 = 2 + nbghostcells 656 581 # if defined key_vertical 657 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)658 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)582 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 583 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 659 584 # else 660 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)661 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)585 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 586 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 662 587 # endif 663 588 664 ! 2. Type of interpolation665 !-------------------------666 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)667 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)668 669 ! 3. Location of interpolation670 !-----------------------------671 CALL Agrif_Set_bc(trn_id,(/0,ind1/))672 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))673 674 ! 4. Update type675 !---------------589 ! 2. Type of interpolation 590 !------------------------- 591 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 592 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 593 594 ! 3. Location of interpolation 595 !----------------------------- 596 CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 597 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 598 599 ! 4. Update type 600 !--------------- 676 601 # if defined UPD_HIGH 677 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)602 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 678 603 #else 679 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)604 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 680 605 #endif 681 606 ! 682 END SUBROUTINE agrif_declare_var_top607 END SUBROUTINE agrif_declare_var_top 683 608 # endif 684 609 685 SUBROUTINE Agrif_detect( kg, ksizex )610 SUBROUTINE Agrif_detect( kg, ksizex ) 686 611 !!---------------------------------------------------------------------- 687 612 !! *** ROUTINE Agrif_detect *** 688 613 !!---------------------------------------------------------------------- 689 INTEGER, DIMENSION(2) :: ksizex 690 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 691 !!---------------------------------------------------------------------- 692 ! 693 RETURN 694 ! 695 END SUBROUTINE Agrif_detect 696 697 698 SUBROUTINE agrif_nemo_init 614 INTEGER, DIMENSION(2) :: ksizex 615 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 616 !!---------------------------------------------------------------------- 617 ! 618 RETURN 619 ! 620 END SUBROUTINE Agrif_detect 621 622 SUBROUTINE agrif_nemo_init 699 623 !!---------------------------------------------------------------------- 700 624 !! *** ROUTINE agrif_init *** 701 625 !!---------------------------------------------------------------------- 702 USE agrif_oce 703 USE agrif_ice 704 USE in_out_manager 705 USE lib_mpp 706 !! 707 IMPLICIT NONE 708 ! 709 INTEGER :: ios ! Local integer output status for namelist read 710 INTEGER :: iminspon 711 NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 626 USE agrif_oce 627 USE agrif_ice 628 USE in_out_manager 629 USE lib_mpp 630 !! 631 IMPLICIT NONE 632 ! 633 INTEGER :: ios ! Local integer output status for namelist read 634 NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 712 635 !!-------------------------------------------------------------------------------------- 713 !714 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom715 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)636 ! 637 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom 638 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 716 639 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 717 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom718 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )640 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom 641 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 719 642 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 720 IF(lwm) WRITE ( numond, namagrif ) 721 ! 722 IF(lwp) THEN ! control print 723 WRITE(numout,*) 724 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 725 WRITE(numout,*) '~~~~~~~~~~~~~~~' 726 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 727 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s' 728 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' 729 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 730 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 731 ENDIF 732 ! 733 ! convert DOCTOR namelist name into OLD names 734 visc_tra = rn_sponge_tra 735 visc_dyn = rn_sponge_dyn 736 ! 737 ! Check sponge length: 738 iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 739 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 740 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 741 ! 742 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 743 ! 744 END SUBROUTINE agrif_nemo_init 643 IF(lwm) WRITE ( numond, namagrif ) 644 ! 645 IF(lwp) THEN ! control print 646 WRITE(numout,*) 647 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 648 WRITE(numout,*) '~~~~~~~~~~~~~~~' 649 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 650 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 651 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 652 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 653 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 654 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 655 ENDIF 656 ! 657 ! 658 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 659 ! 660 END SUBROUTINE agrif_nemo_init 745 661 746 662 # if defined key_mpp_mpi 747 663 748 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )664 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 749 665 !!---------------------------------------------------------------------- 750 666 !! *** ROUTINE Agrif_InvLoc *** 751 667 !!---------------------------------------------------------------------- 752 USE dom_oce 753 !! 754 IMPLICIT NONE 755 ! 756 INTEGER :: indglob, indloc, nprocloc, i 757 !!---------------------------------------------------------------------- 758 ! 759 SELECT CASE( i ) 760 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 761 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 762 CASE DEFAULT 763 indglob = indloc 764 END SELECT 765 ! 766 END SUBROUTINE Agrif_InvLoc 767 768 769 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 668 USE dom_oce 669 !! 670 IMPLICIT NONE 671 ! 672 INTEGER :: indglob, indloc, nprocloc, i 673 !!---------------------------------------------------------------------- 674 ! 675 SELECT CASE( i ) 676 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 677 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 678 CASE DEFAULT 679 indglob = indloc 680 END SELECT 681 ! 682 END SUBROUTINE Agrif_InvLoc 683 684 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 770 685 !!---------------------------------------------------------------------- 771 686 !! *** ROUTINE Agrif_get_proc_info *** 772 687 !!---------------------------------------------------------------------- 773 USE par_oce 774 !! 775 IMPLICIT NONE 776 ! 777 INTEGER, INTENT(out) :: imin, imax 778 INTEGER, INTENT(out) :: jmin, jmax 779 !!---------------------------------------------------------------------- 780 ! 781 imin = nimppt(Agrif_Procrank+1) ! ????? 782 jmin = njmppt(Agrif_Procrank+1) ! ????? 783 imax = imin + jpi - 1 784 jmax = jmin + jpj - 1 785 ! 786 END SUBROUTINE Agrif_get_proc_info 787 788 789 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 688 USE par_oce 689 !! 690 IMPLICIT NONE 691 ! 692 INTEGER, INTENT(out) :: imin, imax 693 INTEGER, INTENT(out) :: jmin, jmax 694 !!---------------------------------------------------------------------- 695 ! 696 imin = nimppt(Agrif_Procrank+1) ! ????? 697 jmin = njmppt(Agrif_Procrank+1) ! ????? 698 imax = imin + jpi - 1 699 jmax = jmin + jpj - 1 700 ! 701 END SUBROUTINE Agrif_get_proc_info 702 703 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 790 704 !!---------------------------------------------------------------------- 791 705 !! *** ROUTINE Agrif_estimate_parallel_cost *** 792 706 !!---------------------------------------------------------------------- 793 USE par_oce794 !!795 IMPLICIT NONE796 !797 INTEGER, INTENT(in) :: imin, imax798 INTEGER, INTENT(in) :: jmin, jmax799 INTEGER, INTENT(in) :: nbprocs800 REAL(wp), INTENT(out) :: grid_cost801 !!---------------------------------------------------------------------- 802 !803 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)804 !805 END SUBROUTINE Agrif_estimate_parallel_cost707 USE par_oce 708 !! 709 IMPLICIT NONE 710 ! 711 INTEGER, INTENT(in) :: imin, imax 712 INTEGER, INTENT(in) :: jmin, jmax 713 INTEGER, INTENT(in) :: nbprocs 714 REAL(wp), INTENT(out) :: grid_cost 715 !!---------------------------------------------------------------------- 716 ! 717 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 718 ! 719 END SUBROUTINE Agrif_estimate_parallel_cost 806 720 807 721 # endif 808 722 809 723 #else 810 SUBROUTINE Subcalledbyagrif724 SUBROUTINE Subcalledbyagrif 811 725 !!---------------------------------------------------------------------- 812 726 !! *** ROUTINE Subcalledbyagrif *** 813 727 !!---------------------------------------------------------------------- 814 WRITE(*,*) 'Impossible to be here'815 END SUBROUTINE Subcalledbyagrif728 WRITE(*,*) 'Impossible to be here' 729 END SUBROUTINE Subcalledbyagrif 816 730 #endif -
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/DYN/dynspg_ts.F90
r11573 r11574 483 483 ! ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d 484 484 IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 485 ! 485 ! 486 486 ! ! resulting flux at mid-step (not over the full domain) 487 487 zhU(1:jpim1,1:jpj ) = e2u(1:jpim1,1:jpj ) * ua_e(1:jpim1,1:jpj ) * zhup2_e(1:jpim1,1:jpj ) ! not jpi-column … … 490 490 #if defined key_agrif 491 491 ! Set fluxes during predictor step to ensure volume conservation 492 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 493 IF((nbondi == -1).OR.(nbondi == 2)) THEN 494 DO jj = 1, jpj 495 zhU(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj) 496 zhV(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * e1v(2:nbghostcells+1,jj) 497 END DO 498 ENDIF 499 IF((nbondi == 1).OR.(nbondi == 2)) THEN 500 DO jj=1,jpj 501 zhU(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 502 zhV(nlci-nbghostcells :nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * e1v(nlci-nbghostcells :nlci-1,jj) 503 END DO 504 ENDIF 505 IF((nbondj == -1).OR.(nbondj == 2)) THEN 506 DO ji=1,jpi 507 zhV(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1) 508 zhU(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * e2u(ji,2:nbghostcells+1) 509 END DO 510 ENDIF 511 IF((nbondj == 1).OR.(nbondj == 2)) THEN 512 DO ji=1,jpi 513 zhV(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 514 zhU(ji,nlcj-nbghostcells :nlcj-1) = ubdy_n(ji,1:nbghostcells) * e2u(ji,nlcj-nbghostcells :nlcj-1) 515 END DO 516 ENDIF 517 ENDIF 492 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV ) 518 493 #endif 519 494 IF( ln_wd_il ) CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt) !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
Note: See TracChangeset
for help on using the changeset viewer.