Changeset 11574 for NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90
- Timestamp:
- 2019-09-19T12:08:31+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.