Changeset 11542
- Timestamp:
- 2019-09-13T15:27:41+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/cfgs/SHARED/namelist_ref
r10808 r11542 556 556 &namagrif ! AGRIF zoom ("key_agrif") 557 557 !----------------------------------------------------------------------- 558 ln_agrif_2way = .true. ! activate two nesting 558 559 ln_spc_dyn = .true. ! use 0 as special value for dynamics 559 560 rn_sponge_tra = 2880. ! coefficient for tracer sponge layer [m2/s] -
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_all_update.F90
r10069 r11542 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_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_ice_update.F90
r10069 r11542 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_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce.F90
r11244 r11542 21 21 #endif 22 22 ! !!* Namelist namagrif: AGRIF parameters 23 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: 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 24 26 REAL(wp), PUBLIC :: rn_sponge_tra = 2800. !: sponge coeff. for tracers 25 27 REAL(wp), PUBLIC :: rn_sponge_dyn = 2800. !: sponge coeff. for dynamics -
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce_sponge.F90
r11244 r11542 109 109 110 110 ztabramp(:,:) = 0._wp 111 IF ( Agrif_irhox()==1 ) ispongearea =-1 112 IF ( Agrif_irhoy()==1 ) jspongearea =-1 111 113 112 114 ! --- West --- ! -
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce_update.F90
r10068 r11542 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_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_top_update.F90
r10068 r11542 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_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_user.F90
r11244 r11542 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(:,:) = 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(:,:) = 0.e0 ; vbdy(:,:) = 0.e0 202 ENDIF 203 204 Agrif_UseSpecialValue = .FALSE. 205 ! reset velocities to zero 206 ua(:,:,:) = 0. 207 va(:,:,:) = 0. 208 209 ! 3. Some controls 210 !----------------- 211 check_namelist = .TRUE. 212 213 IF( check_namelist ) THEN 214 215 ! Check time steps 216 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 217 WRITE(cl_check1,*) NINT(Agrif_Parent(rdt)) 218 WRITE(cl_check2,*) NINT(rdt) 219 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 220 CALL ctl_stop( 'Incompatible time step between ocean grids', & 221 & 'parent grid value : '//cl_check1 , & 222 & 'child grid value : '//cl_check2 , & 223 & 'value on child grid should be changed to : '//cl_check3 ) 224 ENDIF 225 226 ! Check run length 227 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 228 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 229 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 230 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 231 CALL ctl_warn( 'Incompatible run length between grids' , & 232 & 'nit000 on fine grid will be changed to : '//cl_check1, & 233 & 'nitend on fine grid will be changed to : '//cl_check2 ) 234 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 235 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 236 ENDIF 237 238 ! Check free surface scheme 239 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 240 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 241 WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts ) 242 WRITE(cl_check2,*) ln_dynspg_ts 243 WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp ) 244 WRITE(cl_check4,*) ln_dynspg_exp 245 CALL ctl_stop( 'Incompatible free surface scheme between grids' , & 246 & 'parent grid ln_dynspg_ts :'//cl_check1 , & 247 & 'child grid ln_dynspg_ts :'//cl_check2 , & 248 & 'parent grid ln_dynspg_exp :'//cl_check3 , & 249 & 'child grid ln_dynspg_exp :'//cl_check4 , & 250 & 'those logicals should be identical' ) 251 STOP 252 ENDIF 253 254 ! Check if identical linear free surface option 255 IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 256 & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 257 WRITE(cl_check1,*) Agrif_Parent(ln_linssh ) 258 WRITE(cl_check2,*) ln_linssh 259 CALL ctl_stop( 'Incompatible linearized fs option between grids', & 260 & 'parent grid ln_linssh :'//cl_check1 , & 261 & 'child grid ln_linssh :'//cl_check2 , & 262 & 'those logicals should be identical' ) 263 STOP 264 ENDIF 265 266 ! check if masks and bathymetries match 267 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 268 227 ! 269 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 270 ! 271 kindic_agr = 0 272 ! check if umask agree with parent along western and eastern boundaries: 273 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 274 ! check if vmask agree with parent along northern and southern boundaries: 275 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 276 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 277 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 278 ! 279 CALL mpp_sum( 'agrif_user', kindic_agr ) 280 IF( kindic_agr /= 0 ) THEN 281 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 282 ELSE 283 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 284 END IF 285 ENDIF 286 ! 287 ENDIF 288 ! 289 END SUBROUTINE Agrif_InitValues_cont 290 291 SUBROUTINE agrif_declare_var 292 !!---------------------------------------------------------------------- 293 !! *** ROUTINE agrif_declarE_var *** 294 !! 295 !! ** Purpose :: Declaration of variables to be interpolated 296 !!---------------------------------------------------------------------- 297 USE agrif_util 298 USE agrif_oce 299 USE par_oce ! ocean parameters 300 USE zdf_oce ! vertical physics 301 USE oce 302 ! 303 IMPLICIT NONE 304 ! 305 INTEGER :: ind1, ind2, ind3 306 !!---------------------------------------------------------------------- 307 308 ! 1. Declaration of the type of variable which have to be interpolated 309 !--------------------------------------------------------------------- 310 ind1 = nbghostcells 311 ind2 = 1 + nbghostcells 312 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 313 252 # if defined key_vertical 314 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)315 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)316 317 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)318 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)319 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)320 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)321 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)322 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) 323 262 # else 324 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)325 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)326 327 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)328 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)329 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)330 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)331 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)332 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) 333 272 # endif 334 273 335 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)336 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)337 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)338 339 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)340 341 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)342 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)343 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)344 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)345 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)346 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)347 348 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)349 350 IF( ln_zdftke.OR.ln_zdfgls ) THEN351 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)352 ! 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) 353 292 # if defined key_vertical 354 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) 355 294 # else 356 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) 357 296 # endif 358 ENDIF359 360 ! 2. Type of interpolation361 !-------------------------362 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)363 364 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)365 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)366 367 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)368 369 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)370 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)371 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)372 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)373 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)374 375 376 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)377 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)378 379 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)380 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)381 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)382 383 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )384 385 ! 3. Location of interpolation386 !-----------------------------387 CALL Agrif_Set_bc( tsn_id, (/0,ind1/) )388 CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )389 CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )390 391 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 9392 CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )393 CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )394 395 CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )396 CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )397 CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )398 CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )399 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )400 401 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west and rhox=3 and ghost=1: column 2 to 6402 CALL Agrif_Set_bc( umsk_id, (/0,0/) )403 CALL Agrif_Set_bc( vmsk_id, (/0,0/) )404 405 406 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )407 408 ! 4. Update type409 !---------------410 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) 411 350 412 351 # if defined UPD_HIGH 413 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)414 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)415 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)416 417 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)418 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)419 CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)420 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)421 422 IF( ln_zdftke.OR.ln_zdfgls ) THEN423 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)424 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)425 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)426 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 427 366 428 367 #else 429 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)430 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)431 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)432 433 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)434 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)435 CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)436 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)437 438 IF( ln_zdftke.OR.ln_zdfgls ) THEN439 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)440 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)441 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)442 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 443 382 444 383 #endif 445 !446 END SUBROUTINE agrif_declare_var384 ! 385 END SUBROUTINE agrif_declare_var 447 386 448 387 #if defined key_si3 … … 450 389 !!---------------------------------------------------------------------- 451 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 452 501 !! 453 !! ** Purpose :: Initialisation of variables to be interpolated for ice 454 !!---------------------------------------------------------------------- 455 USE Agrif_Util 456 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 457 USE ice 458 USE agrif_ice 459 USE in_out_manager 460 USE agrif_ice_interp 461 USE lib_mpp 462 ! 463 IMPLICIT NONE 464 !!---------------------------------------------------------------------- 465 ! 466 ! Declaration of the type of variable which have to be interpolated (parent=>child) 467 !---------------------------------------------------------------------------------- 468 CALL agrif_declare_var_ice 469 470 ! Controls 471 472 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 473 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 474 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 475 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 476 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 477 478 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 479 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN 480 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 481 ENDIF 482 ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 483 !---------------------------------------------------------------------- 484 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) 485 CALL agrif_interp_ice('U') ! interpolation of ice velocities 486 CALL agrif_interp_ice('V') ! interpolation of ice velocities 487 CALL agrif_interp_ice('T') ! interpolation of ice tracers 488 nbstep_ice = 0 489 490 ! 491 END SUBROUTINE Agrif_InitValues_cont_ice 492 493 SUBROUTINE agrif_declare_var_ice 494 !!---------------------------------------------------------------------- 495 !! *** ROUTINE agrif_declare_var_ice *** 496 !! 497 !! ** Purpose :: Declaration of variables to be interpolated for ice 498 !!---------------------------------------------------------------------- 499 USE Agrif_Util 500 USE ice 501 USE par_oce, ONLY : nbghostcells 502 ! 503 IMPLICIT NONE 504 ! 505 INTEGER :: ind1, ind2, ind3 506 !!---------------------------------------------------------------------- 507 ! 508 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 509 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name) 510 ! ex.: position=> 1,1 = not-centered (in i and j) 511 ! 2,2 = centered ( - ) 512 ! index => 1,1 = one ghost line 513 ! 2,2 = two ghost lines 514 !------------------------------------------------------------------------------------- 515 ind1 = nbghostcells 516 ind2 = 1 + nbghostcells 517 ind3 = 2 + nbghostcells 518 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) 519 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 520 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 521 522 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 523 !----------------------------------- 524 CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear) 525 CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm ) 526 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 527 528 ! 3. Set location of interpolations 529 !---------------------------------- 530 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 531 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 532 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 533 534 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 535 !-------------------------------------------------- 536 # if defined UPD_HIGH 537 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 538 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 539 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 540 #else 541 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 542 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 543 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 544 #endif 545 546 END SUBROUTINE agrif_declare_var_ice 547 #endif 548 549 550 # if defined key_top 551 SUBROUTINE Agrif_InitValues_cont_top 552 !!---------------------------------------------------------------------- 553 !! *** ROUTINE Agrif_InitValues_cont_top *** 554 !! 555 !! ** Purpose :: Declaration of variables to be interpolated 556 !!---------------------------------------------------------------------- 557 USE Agrif_Util 558 USE oce 559 USE dom_oce 560 USE nemogcm 561 USE par_trc 562 USE lib_mpp 563 USE trc 564 USE in_out_manager 565 USE agrif_oce_sponge 566 USE agrif_top_update 567 USE agrif_top_interp 568 USE agrif_top_sponge 569 !! 570 IMPLICIT NONE 571 ! 572 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 573 LOGICAL :: check_namelist 574 !!---------------------------------------------------------------------- 575 576 577 ! 1. Declaration of the type of variable which have to be interpolated 578 !--------------------------------------------------------------------- 579 CALL agrif_declare_var_top 580 581 ! 2. First interpolations of potentially non zero fields 582 !------------------------------------------------------- 583 Agrif_SpecialValue=0. 584 Agrif_UseSpecialValue = .TRUE. 585 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 586 Agrif_UseSpecialValue = .FALSE. 587 CALL Agrif_Sponge 588 tabspongedone_trn = .FALSE. 589 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 590 ! reset tsa to zero 591 tra(:,:,:,:) = 0. 592 593 594 ! 3. Some controls 595 !----------------- 596 check_namelist = .TRUE. 597 598 IF( check_namelist ) THEN 599 ! 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 600 530 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 601 531 WRITE(cl_check1,*) Agrif_Parent(rdt) … … 627 557 ENDIF 628 558 ! 629 END SUBROUTINE Agrif_InitValues_cont_top630 631 632 SUBROUTINE agrif_declare_var_top559 END SUBROUTINE Agrif_InitValues_cont_top 560 561 562 SUBROUTINE agrif_declare_var_top 633 563 !!---------------------------------------------------------------------- 634 564 !! *** ROUTINE agrif_declare_var_top *** 565 !!---------------------------------------------------------------------- 566 USE agrif_util 567 USE agrif_oce 568 USE dom_oce 569 USE trc 635 570 !! 636 !! ** Purpose :: Declaration of TOP variables to be interpolated 637 !!---------------------------------------------------------------------- 638 USE agrif_util 639 USE agrif_oce 640 USE dom_oce 641 USE trc 642 !! 643 IMPLICIT NONE 644 ! 645 INTEGER :: ind1, ind2, ind3 646 !!---------------------------------------------------------------------- 647 648 ! 1. Declaration of the type of variable which have to be interpolated 649 !--------------------------------------------------------------------- 650 ind1 = nbghostcells 651 ind2 = 1 + nbghostcells 652 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 653 581 # if defined key_vertical 654 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)655 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) 656 584 # else 657 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)658 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) 659 587 # endif 660 588 661 ! 2. Type of interpolation662 !-------------------------663 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)664 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)665 666 ! 3. Location of interpolation667 !-----------------------------668 CALL Agrif_Set_bc(trn_id,(/0,ind1/))669 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))670 671 ! 4. Update type672 !---------------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 !--------------- 673 601 # if defined UPD_HIGH 674 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)602 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 675 603 #else 676 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)604 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 677 605 #endif 678 606 ! 679 END SUBROUTINE agrif_declare_var_top607 END SUBROUTINE agrif_declare_var_top 680 608 # endif 681 609 682 SUBROUTINE Agrif_detect( kg, ksizex )610 SUBROUTINE Agrif_detect( kg, ksizex ) 683 611 !!---------------------------------------------------------------------- 684 612 !! *** ROUTINE Agrif_detect *** 685 613 !!---------------------------------------------------------------------- 686 INTEGER, DIMENSION(2) :: ksizex 687 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 688 !!---------------------------------------------------------------------- 689 ! 690 RETURN 691 ! 692 END SUBROUTINE Agrif_detect 693 694 695 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 696 623 !!---------------------------------------------------------------------- 697 624 !! *** ROUTINE agrif_init *** 698 625 !!---------------------------------------------------------------------- 699 USE agrif_oce 700 USE agrif_ice 701 USE in_out_manager 702 USE lib_mpp 703 !! 704 IMPLICIT NONE 705 ! 706 INTEGER :: ios ! Local integer output status for namelist read 707 INTEGER :: iminspon 708 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 709 635 !!-------------------------------------------------------------------------------------- 710 !711 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom712 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) 713 639 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 714 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom715 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 ) 716 642 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 717 IF(lwm) WRITE ( numond, namagrif ) 718 ! 719 IF(lwp) THEN ! control print 720 WRITE(numout,*) 721 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 722 WRITE(numout,*) '~~~~~~~~~~~~~~~' 723 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 724 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s' 725 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' 726 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 727 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 728 ENDIF 729 ! 730 ! 731 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 732 ! 733 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 734 661 735 662 # if defined key_mpp_mpi 736 663 737 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )664 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 738 665 !!---------------------------------------------------------------------- 739 666 !! *** ROUTINE Agrif_InvLoc *** 740 667 !!---------------------------------------------------------------------- 741 USE dom_oce 742 !! 743 IMPLICIT NONE 744 ! 745 INTEGER :: indglob, indloc, nprocloc, i 746 !!---------------------------------------------------------------------- 747 ! 748 SELECT CASE( i ) 749 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 750 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 751 CASE DEFAULT 752 indglob = indloc 753 END SELECT 754 ! 755 END SUBROUTINE Agrif_InvLoc 756 757 758 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 ) 759 685 !!---------------------------------------------------------------------- 760 686 !! *** ROUTINE Agrif_get_proc_info *** 761 687 !!---------------------------------------------------------------------- 762 USE par_oce 763 !! 764 IMPLICIT NONE 765 ! 766 INTEGER, INTENT(out) :: imin, imax 767 INTEGER, INTENT(out) :: jmin, jmax 768 !!---------------------------------------------------------------------- 769 ! 770 imin = nimppt(Agrif_Procrank+1) ! ????? 771 jmin = njmppt(Agrif_Procrank+1) ! ????? 772 imax = imin + jpi - 1 773 jmax = jmin + jpj - 1 774 ! 775 END SUBROUTINE Agrif_get_proc_info 776 777 778 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) 779 704 !!---------------------------------------------------------------------- 780 705 !! *** ROUTINE Agrif_estimate_parallel_cost *** 781 706 !!---------------------------------------------------------------------- 782 USE par_oce783 !!784 IMPLICIT NONE785 !786 INTEGER, INTENT(in) :: imin, imax787 INTEGER, INTENT(in) :: jmin, jmax788 INTEGER, INTENT(in) :: nbprocs789 REAL(wp), INTENT(out) :: grid_cost790 !!---------------------------------------------------------------------- 791 !792 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)793 !794 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 795 720 796 721 # endif 797 722 798 723 #else 799 SUBROUTINE Subcalledbyagrif724 SUBROUTINE Subcalledbyagrif 800 725 !!---------------------------------------------------------------------- 801 726 !! *** ROUTINE Subcalledbyagrif *** 802 727 !!---------------------------------------------------------------------- 803 WRITE(*,*) 'Impossible to be here'804 END SUBROUTINE Subcalledbyagrif728 WRITE(*,*) 'Impossible to be here' 729 END SUBROUTINE Subcalledbyagrif 805 730 #endif
Note: See TracChangeset
for help on using the changeset viewer.