Changeset 13286 for NEMO/trunk/src/NST/agrif_user.F90
- Timestamp:
- 2020-07-09T17:48:29+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_user.F90 (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools /@HEADtools4 ^/utils/tools@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM … … 8 8 9 9 # SETTE 10 ^/utils/CI/ sette@12931sette10 ^/utils/CI/r12931_sette_ticket2366@HEAD sette
-
- Property svn:externals
-
NEMO/trunk/src/NST/agrif_user.F90
r13226 r13286 11 11 END SUBROUTINE agrif_user 12 12 13 13 14 SUBROUTINE agrif_before_regridding 14 15 END SUBROUTINE agrif_before_regridding 15 16 17 16 18 SUBROUTINE Agrif_InitWorkspace 17 19 END SUBROUTINE Agrif_InitWorkspace 18 20 21 19 22 SUBROUTINE Agrif_InitValues 20 23 !!---------------------------------------------------------------------- … … 38 41 END SUBROUTINE Agrif_initvalues 39 42 40 SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 41 42 USE domvvl 43 USE domain 44 USE par_oce 45 USE agrif_oce 46 USE agrif_oce_interp 47 USE oce 48 USE lib_mpp 49 USe lbclnk 50 43 44 SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 45 !!---------------------------------------------------------------------- 46 !! *** ROUTINE agrif_istate *** 47 !!---------------------------------------------------------------------- 48 USE domvvl 49 USE domain 50 USE par_oce 51 USE agrif_oce 52 USE agrif_oce_interp 53 USE oce 54 USE lib_mpp 55 USE lbclnk 56 ! 57 IMPLICIT NONE 58 ! 51 59 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 52 60 INTEGER :: jn 53 61 !!---------------------------------------------------------------------- 54 62 IF(lwp) WRITE(numout,*) ' ' 55 63 IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 56 64 IF(lwp) WRITE(numout,*) ' ' 57 65 58 l_ini_child = .TRUE.59 Agrif_SpecialValue = 0. _wp66 l_ini_child = .TRUE. 67 Agrif_SpecialValue = 0.0_wp 60 68 Agrif_UseSpecialValue = .TRUE. 61 uu(:,:,:,:) = 0. ; vv(:,:,:,:) = 0. ; ts(:,:,:,:,:) = 0.69 uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp 62 70 63 Krhs_a = Kbb ;Kmm_a = Kbb71 Krhs_a = Kbb ; Kmm_a = Kbb 64 72 65 73 ! Brutal fix to pas 1x1 refinment. … … 79 87 use_sign_north = .FALSE. 80 88 81 Agrif_UseSpecialValue = .FALSE. !82 l_ini_child = .FALSE.83 84 Krhs_a = Kaa ;Kmm_a = Kmm89 Agrif_UseSpecialValue = .FALSE. 90 l_ini_child = .FALSE. 91 92 Krhs_a = Kaa ; Kmm_a = Kmm 85 93 86 94 DO jn = 1, jpts 87 95 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 88 96 END DO 89 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 90 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 91 92 93 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 94 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 95 96 END SUBROUTINE agrif_istate 97 97 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 98 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 99 100 101 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 102 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 103 104 END SUBROUTINE Agrif_Istate 105 106 98 107 SUBROUTINE agrif_declare_var_ini 99 108 !!---------------------------------------------------------------------- 100 !! *** ROUTINE agrif_declare_var ***109 !! *** ROUTINE agrif_declare_var_ini *** 101 110 !!---------------------------------------------------------------------- 102 111 USE agrif_util … … 110 119 ! 111 120 INTEGER :: ind1, ind2, ind3 121 INTEGER :: its 112 122 External :: nemo_mapping 113 123 !!---------------------------------------------------------------------- … … 126 136 ! 1. Declaration of the type of variable which have to be interpolated 127 137 !--------------------------------------------------------------------- 128 ind1 = nbghostcells 129 ind2 = 2 + nbghostcells_x 130 ind3 = 2 + nbghostcells_y_s 131 132 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 133 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 134 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 135 136 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 137 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 138 138 ind1 = nbghostcells 139 ind2 = nn_hls + 2 + nbghostcells_x 140 ind3 = nn_hls + 2 + nbghostcells_y_s 141 142 CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id) 143 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id) 144 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id) 145 146 CALL agrif_declare_variable((/1,2 /),(/ind2-1,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e1u_id) 147 CALL agrif_declare_variable((/2,1 /),(/ind2 ,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e2v_id) 139 148 140 149 ! Initial or restart velues 141 142 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jpts+1/),tsini_id)143 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/) ,uini_id)144 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/) ,vini_id)145 CALL agrif_declare_variable((/2,2 /) ,(/ind2,ind3/) ,(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id)150 its = jpts+1 151 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 152 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), uini_id) 153 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id) 154 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id) 146 155 ! 147 156 148 157 ! 2. Type of interpolation 149 158 !------------------------- 150 CALL Agrif_Set_bcinterp( e3t_id,interp=AGRIF_constant)151 152 CALL Agrif_Set_bcinterp( mbkt_id,interp=AGRIF_constant)153 CALL Agrif_Set_interp ( mbkt_id,interp=AGRIF_constant)154 CALL Agrif_Set_bcinterp( ht0_id ,interp=AGRIF_constant)155 CALL Agrif_Set_interp ( ht0_id ,interp=AGRIF_constant)156 157 CALL Agrif_Set_bcinterp( e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm )158 CALL Agrif_Set_bcinterp( e2v_id,interp1=AGRIF_ppm , interp2=Agrif_linear )159 CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant) 160 161 CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant) 162 CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant) 163 CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant) 164 CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant) 165 166 CALL Agrif_Set_bcinterp( e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm ) 167 CALL Agrif_Set_bcinterp( e2v_id,interp1=AGRIF_ppm , interp2=Agrif_linear ) 159 168 160 169 ! Initial fields 161 CALL Agrif_Set_bcinterp( tsini_id ,interp=AGRIF_linear)162 CALL Agrif_Set_interp ( tsini_id ,interp=AGRIF_linear)163 CALL Agrif_Set_bcinterp( uini_id ,interp=AGRIF_linear)164 CALL Agrif_Set_interp ( uini_id ,interp=AGRIF_linear)165 CALL Agrif_Set_bcinterp( vini_id ,interp=AGRIF_linear)166 CALL Agrif_Set_interp ( vini_id ,interp=AGRIF_linear)167 CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear)168 CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear)170 CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear ) 171 CALL Agrif_Set_interp ( tsini_id,interp =AGRIF_linear ) 172 CALL Agrif_Set_bcinterp( uini_id,interp =AGRIF_linear ) 173 CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear ) 174 CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear ) 175 CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear ) 176 CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear ) 177 CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear ) 169 178 170 179 ! 3. Location of interpolation … … 172 181 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 173 182 ! JC: check near the boundary only until matching in sponge has been sorted out: 174 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) )183 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 175 184 176 185 ! extend the interpolation zone by 1 more point than necessary: 177 186 ! RB check here 178 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )179 CALL Agrif_Set_bc( ht0_id,(/-nn_sponge_len*Agrif_irhox()-2,ind1/) )187 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 188 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 180 189 181 CALL Agrif_Set_bc( e1u_id,(/0,ind1-1/))182 CALL Agrif_Set_bc( e2v_id,(/0,ind1-1/))183 184 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4185 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) )186 CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) )190 CALL Agrif_Set_bc( e1u_id, (/0,ind1-1/) ) 191 CALL Agrif_Set_bc( e2v_id, (/0,ind1-1/) ) 192 193 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 194 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) ) 195 CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) ) 187 196 CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 188 197 … … 190 199 !--------------- 191 200 # if defined UPD_HIGH 192 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting)193 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average )201 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting) 202 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average ) 194 203 #else 195 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average)196 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy)204 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average ) 205 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy ) 197 206 #endif 198 207 … … 204 213 SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 205 214 !!---------------------------------------------------------------------- 206 !! *** ROUTINE Agrif_InitValues_cont_dom *** 207 !!---------------------------------------------------------------------- 208 209 !!---------------------------------------------------------------------- 210 !! *** ROUTINE Agrif_InitValues_cont *** 211 !! 212 !! ** Purpose :: Declaration of variables to be interpolated 213 !!---------------------------------------------------------------------- 215 !! *** ROUTINE Agrif_Init_Domain *** 216 !!---------------------------------------------------------------------- 214 217 USE agrif_oce_update 215 218 USE agrif_oce_interp … … 243 246 ! on the child grid 244 247 Agrif_UseSpecialValue = .FALSE. 245 ht0_parent( :,:) = 0._wp248 ht0_parent( :,:) = 0._wp 246 249 mbkt_parent(:,:) = 0 247 250 ! … … 255 258 ! and no refinement 256 259 DO_2D_10_10 257 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ) , mbkt_parent(ji,jj))258 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1) , mbkt_parent(ji,jj))260 mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ), mbkt_parent(ji,jj) ) 261 mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1), mbkt_parent(ji,jj) ) 259 262 END_2D 260 263 IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN … … 265 268 ELSE 266 269 DO_2D_10_10 267 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )268 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )270 hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 271 hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 269 272 END_2D 270 271 ENDIF 272 ! 273 CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp ) 274 CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1.0_wp ) 275 zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk('Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 276 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 277 zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 273 ENDIF 274 ! 275 CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 276 DO_2D_00_00 277 zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 278 END_2D 279 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 280 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 281 DO_2D_00_00 282 zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 283 END_2D 284 CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 278 285 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 279 286 … … 333 340 334 341 SUBROUTINE Agrif_InitValues_cont 335 336 337 338 339 342 !!---------------------------------------------------------------------- 343 !! *** ROUTINE Agrif_InitValues_cont *** 344 !! 345 !! ** Purpose :: Declaration of variables to be interpolated 346 !!---------------------------------------------------------------------- 340 347 USE agrif_oce_update 341 348 USE agrif_oce_interp … … 367 374 Agrif_SpecialValue = 0._wp 368 375 Agrif_UseSpecialValue = .TRUE. 369 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn)376 CALL Agrif_Bc_variable( tsn_id,calledweight=1.,procname=interptsn) 370 377 CALL Agrif_Sponge 371 378 tabspongedone_tsn = .FALSE. … … 398 405 use_sign_north = .TRUE. 399 406 sign_north = -1. 400 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb)401 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb)407 CALL Agrif_Bc_variable( unb_id,calledweight=1.,procname=interpunb ) 408 CALL Agrif_Bc_variable( vnb_id,calledweight=1.,procname=interpvnb ) 402 409 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 403 410 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) … … 460 467 ! 1. Declaration of the type of variable which have to be interpolated 461 468 !--------------------------------------------------------------------- 462 463 ind1 = nbghostcells 464 ind2 = 2 + nbghostcells_x 465 ind3 = 2 + nbghostcells_y_s 466 469 ind1 = nbghostcells 470 ind2 = nn_hls + 2 + nbghostcells_x 471 ind3 = nn_hls + 2 + nbghostcells_y_s 467 472 # if defined key_vertical 468 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jpts+1/),tsn_id)469 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)470 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),un_interp_id)471 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),vn_interp_id)472 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),un_update_id)473 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),vn_update_id)474 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),un_sponge_id)475 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),vn_sponge_id)473 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 474 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 475 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 476 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 477 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 478 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 479 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 480 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 476 481 # else 477 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jpts/),tsn_id)478 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jpts/),tsn_sponge_id)479 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),un_interp_id)480 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),vn_interp_id)481 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),un_update_id)482 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),vn_update_id)483 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),un_sponge_id)484 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),vn_sponge_id)482 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 483 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 484 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 485 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 486 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 487 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 488 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 489 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 485 490 # endif 486 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 487 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 488 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 489 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 490 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 491 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 492 493 CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 491 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 492 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 493 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 494 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 495 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 496 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 497 498 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 499 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 500 CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 494 501 495 502 496 503 IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point 497 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/ nlci,nlcj,jpk/), en_id)498 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/ nlci,nlcj,jpk/),avt_id)504 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 505 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 499 506 # if defined key_vertical 500 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,2/),avm_id)507 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 501 508 # else 502 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,1/),avm_id)509 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 503 510 # endif 504 511 ENDIF … … 506 513 ! 2. Type of interpolation 507 514 !------------------------- 508 CALL Agrif_Set_bcinterp( tsn_id,interp=AGRIF_linear)509 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)510 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)511 512 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp=AGRIF_linear)513 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)514 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)515 516 CALL Agrif_Set_bcinterp( sshn_id,interp=AGRIF_linear)517 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)518 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)519 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )520 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)515 CALL Agrif_Set_bcinterp( tsn_id,interp =AGRIF_linear) 516 CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 517 CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 518 519 CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 520 CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 521 CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 522 523 CALL Agrif_Set_bcinterp( sshn_id,interp =AGRIF_linear) 524 CALL Agrif_Set_bcinterp( unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 525 CALL Agrif_Set_bcinterp( vnb_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 526 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm ) 527 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear) 521 528 ! 522 529 ! > Divergence conserving alternative: … … 531 538 532 539 533 ! 3. Location of interpolation 540 ! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 541 ! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 542 543 ! 3. Location of interpolation 534 544 !----------------------------- 535 545 CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 … … 548 558 549 559 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 560 !!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 561 !!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 550 562 551 563 ! 4. Update type … … 553 565 554 566 # if defined UPD_HIGH 555 CALL Agrif_Set_Updatetype( tsn_id, update= Agrif_Update_Full_Weighting)556 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)557 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )558 559 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)560 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )561 CALL Agrif_Set_Updatetype( sshn_id,update= Agrif_Update_Full_Weighting)562 CALL Agrif_Set_Updatetype( e3t_id, update= Agrif_Update_Full_Weighting)567 CALL Agrif_Set_Updatetype( tsn_id,update = Agrif_Update_Full_Weighting) 568 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 569 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 570 571 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 572 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 573 CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting) 574 CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting) 563 575 564 576 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN … … 569 581 570 582 #else 571 CALL Agrif_Set_Updatetype( tsn_id, update= AGRIF_Update_Average)572 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)573 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )574 575 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)576 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )577 CALL Agrif_Set_Updatetype( sshn_id,update= AGRIF_Update_Average)578 CALL Agrif_Set_Updatetype( e3t_id, update= AGRIF_Update_Average)583 CALL Agrif_Set_Updatetype( tsn_id, update = AGRIF_Update_Average) 584 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 585 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 586 587 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 588 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 589 CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average) 590 CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average) 579 591 580 592 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN … … 589 601 590 602 #if defined key_si3 591 SUBROUTINE Agrif_InitValues_cont_ice 603 SUBROUTINE Agrif_InitValues_cont_ice 604 !!---------------------------------------------------------------------- 605 !! *** ROUTINE Agrif_InitValues_cont_ice *** 606 !!---------------------------------------------------------------------- 592 607 USE Agrif_Util 593 608 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc … … 597 612 USE agrif_ice_interp 598 613 USE lib_mpp 599 ! !----------------------------------------------------------------------600 !! *** ROUTINE Agrif_InitValues_cont_ice ***601 ! !----------------------------------------------------------------------602 614 ! 615 IMPLICIT NONE 616 ! 617 !!---------------------------------------------------------------------- 603 618 ! Controls 604 619 … … 623 638 END SUBROUTINE Agrif_InitValues_cont_ice 624 639 640 625 641 SUBROUTINE agrif_declare_var_ice 626 642 !!---------------------------------------------------------------------- 627 643 !! *** ROUTINE agrif_declare_var_ice *** 628 644 !!---------------------------------------------------------------------- 629 630 645 USE Agrif_Util 631 646 USE ice … … 635 650 ! 636 651 INTEGER :: ind1, ind2, ind3 637 !!---------------------------------------------------------------------- 652 INTEGER :: ipl 653 !!---------------------------------------------------------------------- 638 654 ! 639 655 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) … … 644 660 ! 2,2 = two ghost lines 645 661 !------------------------------------------------------------------------------------- 646 647 ind 1 = nbghostcells648 ind 2 = 2 + nbghostcells_x649 i nd3 = 2 + nbghostcells_y_s650 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/ nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)651 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id)652 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id)653 654 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_iceini_id)655 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_iceini_id)656 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_iceini_id)662 ind1 = nbghostcells 663 ind2 = nn_hls + 2 + nbghostcells_x 664 ind3 = nn_hls + 2 + nbghostcells_y_s 665 ipl = jpl*(8+nlay_s+nlay_i) 666 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 667 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id) 668 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id) 669 670 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 671 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id) 672 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id) 657 673 658 674 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 712 728 USE agrif_top_interp 713 729 USE agrif_top_sponge 714 !! 715 716 !! 717 IMPLICIT NONE 718 ! 719 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 720 LOGICAL :: check_namelist 721 !!---------------------------------------------------------------------- 722 723 724 ! 1. Declaration of the type of variable which have to be interpolated 725 !--------------------------------------------------------------------- 726 CALL agrif_declare_var_top 727 728 ! 2. First interpolations of potentially non zero fields 729 !------------------------------------------------------- 730 Agrif_SpecialValue=0. 731 Agrif_UseSpecialValue = .TRUE. 732 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 733 Agrif_UseSpecialValue = .FALSE. 734 CALL Agrif_Sponge 735 tabspongedone_trn = .FALSE. 736 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 737 ! reset tsa to zero 738 tra(:,:,:,:) = 0. 739 740 ! 3. Some controls 741 !----------------- 742 check_namelist = .TRUE. 743 744 IF( check_namelist ) THEN 745 ! Check time steps 746 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 747 WRITE(cl_check1,*) Agrif_Parent(rdt) 748 WRITE(cl_check2,*) rdt 749 WRITE(cl_check3,*) rdt*Agrif_Rhot() 750 CALL ctl_stop( 'incompatible time step between grids', & 730 ! 731 IMPLICIT NONE 732 ! 733 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 734 LOGICAL :: check_namelist 735 !!---------------------------------------------------------------------- 736 737 ! 1. Declaration of the type of variable which have to be interpolated 738 !--------------------------------------------------------------------- 739 CALL agrif_declare_var_top 740 741 ! 2. First interpolations of potentially non zero fields 742 !------------------------------------------------------- 743 Agrif_SpecialValue=0._wp 744 Agrif_UseSpecialValue = .TRUE. 745 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 746 Agrif_UseSpecialValue = .FALSE. 747 CALL Agrif_Sponge 748 tabspongedone_trn = .FALSE. 749 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 750 ! reset tsa to zero 751 tra(:,:,:,:) = 0._wp 752 753 ! 3. Some controls 754 !----------------- 755 check_namelist = .TRUE. 756 757 IF( check_namelist ) THEN 758 ! Check time steps 759 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 760 WRITE(cl_check1,*) Agrif_Parent(rdt) 761 WRITE(cl_check2,*) rdt 762 WRITE(cl_check3,*) rdt*Agrif_Rhot() 763 CALL ctl_stop( 'incompatible time step between grids', & 751 764 & 'parent grid value : '//cl_check1 , & 752 765 & 'child grid value : '//cl_check2 , & 753 766 & 'value on child grid should be changed to & 754 767 & :'//cl_check3 ) 755 ENDIF756 757 ! Check run length758 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &768 ENDIF 769 770 ! Check run length 771 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 759 772 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 760 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1761 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()762 CALL ctl_warn( 'incompatible run length between grids' , &773 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 774 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 775 CALL ctl_warn( 'incompatible run length between grids' , & 763 776 & ' nit000 on fine grid will be change to : '//cl_check1, & 764 777 & ' nitend on fine grid will be change to : '//cl_check2 ) 765 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1766 nitend = Agrif_Parent(nitend) *Agrif_IRhot()767 ENDIF768 ENDIF769 !778 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 779 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 780 ENDIF 781 ENDIF 782 ! 770 783 END SUBROUTINE Agrif_InitValues_cont_top 771 784 … … 784 797 INTEGER :: ind1, ind2, ind3 785 798 !!---------------------------------------------------------------------- 786 787 788 789 799 !RB_CMEMS : declare here init for top 790 800 ! 1. Declaration of the type of variable which have to be interpolated 791 801 !--------------------------------------------------------------------- 792 ind1 = nbghostcells793 ind2 = 2 + nbghostcells_x794 ind3 = 2 + nbghostcells_y_s802 ind1 = nbghostcells 803 ind2 = nn_hls + 2 + nbghostcells_x 804 ind3 = nn_hls + 2 + nbghostcells_y_s 795 805 # if defined key_vertical 796 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jptra+1/),trn_id)797 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ nlci,nlcj,jpk,jptra+1/),trn_sponge_id)806 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 807 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 798 808 # else 799 809 ! LAURENT: STRANGE why (3,3) here ? 800 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)801 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)810 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 811 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 802 812 # endif 803 813 … … 822 832 END SUBROUTINE agrif_declare_var_top 823 833 # endif 834 824 835 825 836 SUBROUTINE Agrif_detect( kg, ksizex ) … … 835 846 END SUBROUTINE Agrif_detect 836 847 848 837 849 SUBROUTINE agrif_nemo_init 838 850 !!---------------------------------------------------------------------- 839 851 !! *** ROUTINE agrif_init *** 840 852 !!---------------------------------------------------------------------- 841 USE agrif_oce842 USE agrif_ice843 USE dom_oce844 USE in_out_manager845 USE lib_mpp846 ! !853 USE agrif_oce 854 USE agrif_ice 855 USE dom_oce 856 USE in_out_manager 857 USE lib_mpp 858 ! 847 859 IMPLICIT NONE 848 860 ! … … 880 892 ! 881 893 ! Set the number of ghost cells according to periodicity 882 nbghostcells_x = nbghostcells894 nbghostcells_x = nbghostcells 883 895 nbghostcells_y_s = nbghostcells 884 896 nbghostcells_y_n = nbghostcells 885 897 ! 886 IF ( jperio == 1 ) nbghostcells_x = 0 887 IF ( .NOT. lk_south ) nbghostcells_y_s = 0 888 898 IF( jperio == 1 ) nbghostcells_x = 0 899 IF( .NOT. lk_south ) nbghostcells_y_s = 0 889 900 ! Some checks 890 IF( jpiglo /= nbcellsx + 2 + 2*n bghostcells_x )&891 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2+ 2*nbghostcells_x' )892 IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )&893 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2+ nbghostcells_y_s + nbghostcells_y_n' )901 IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', & 902 & 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 903 IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', & 904 & 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 894 905 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 895 906 ! 896 907 END SUBROUTINE agrif_nemo_init 897 908 909 898 910 # if defined key_mpp_mpi 899 911 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) … … 909 921 ! 910 922 SELECT CASE( i ) 911 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 912 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 913 CASE DEFAULT 914 indglob = indloc 923 CASE(1) ; indglob = mig(indloc) 924 CASE(2) ; indglob = mjg(indloc) 925 CASE DEFAULT ; indglob = indloc 915 926 END SELECT 916 927 ! 917 928 END SUBROUTINE Agrif_InvLoc 918 929 930 919 931 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 920 932 !!---------------------------------------------------------------------- … … 929 941 !!---------------------------------------------------------------------- 930 942 ! 931 imin = nimppt(Agrif_Procrank+1) ! ?????932 jmin = njmppt(Agrif_Procrank+1) ! ?????933 imax = imin + jpi - 1934 jmax = jmin + jpj - 1943 imin = mig( 1 ) 944 jmin = mjg( 1 ) 945 imax = mig(jpi) 946 jmax = mjg(jpj) 935 947 ! 936 948 END SUBROUTINE Agrif_get_proc_info 937 949 950 938 951 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 939 952 !!---------------------------------------------------------------------- … … 1130 1143 FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 1131 1144 1132 USE dom_oce 1133 1134 INTEGER :: ptx, pty, i1, isens 1135 INTEGER :: agrif_external_switch_index 1136 1137 IF( isens == 1 ) THEN 1138 IF( ptx == 2 ) THEN ! T, V points 1139 agrif_external_switch_index = jpiglo-i1+2 1140 ELSE ! U, F points 1141 agrif_external_switch_index = jpiglo-i1+1 1142 ENDIF 1143 ELSE IF( isens ==2 ) THEN 1144 IF ( pty == 2 ) THEN ! T, U points 1145 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1146 ELSE ! V, F points 1147 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1148 ENDIF 1149 ENDIF 1145 USE dom_oce 1146 ! 1147 IMPLICIT NONE 1148 1149 INTEGER :: ptx, pty, i1, isens 1150 INTEGER :: agrif_external_switch_index 1151 !!---------------------------------------------------------------------- 1152 1153 IF( isens == 1 ) THEN 1154 IF( ptx == 2 ) THEN ! T, V points 1155 agrif_external_switch_index = jpiglo-i1+2 1156 ELSE ! U, F points 1157 agrif_external_switch_index = jpiglo-i1+1 1158 ENDIF 1159 ELSE IF( isens ==2 ) THEN 1160 IF ( pty == 2 ) THEN ! T, U points 1161 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1162 ELSE ! V, F points 1163 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1164 ENDIF 1165 ENDIF 1150 1166 1151 1167 END FUNCTION agrif_external_switch_index … … 1155 1171 !! *** ROUTINE Correct_field *** 1156 1172 !!---------------------------------------------------------------------- 1157 1158 USE dom_oce 1159 USE agrif_oce 1160 1161 INTEGER :: i1,i2,j1,j2 1162 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1163 1164 INTEGER :: i,j 1165 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1166 1167 tab2dtemp = tab2d 1168 1169 IF( .NOT. use_sign_north ) THEN 1170 DO j=j1,j2 1171 DO i=i1,i2 1172 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1173 USE dom_oce 1174 USE agrif_oce 1175 ! 1176 IMPLICIT NONE 1177 ! 1178 INTEGER :: i1,i2,j1,j2 1179 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1180 ! 1181 INTEGER :: i,j 1182 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1183 !!---------------------------------------------------------------------- 1184 1185 tab2dtemp = tab2d 1186 1187 IF( .NOT. use_sign_north ) THEN 1188 DO j=j1,j2 1189 DO i=i1,i2 1190 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1191 END DO 1173 1192 END DO 1174 E ND DO1175 ELSE1176 DO j=j1,j21177 DO i=i1,i21178 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))1193 ELSE 1194 DO j=j1,j2 1195 DO i=i1,i2 1196 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 1197 END DO 1179 1198 END DO 1180 END DO 1181 ENDIF 1199 ENDIF 1182 1200 1183 1201 END SUBROUTINE Correct_field
Note: See TracChangeset
for help on using the changeset viewer.
