agrif_user.F90 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838
  1. #if defined key_agrif
  2. !!----------------------------------------------------------------------
  3. !! NEMO/NST 3.4 , NEMO Consortium (2012)
  4. !! $Id: agrif_user.F90 5574 2015-07-09 10:38:43Z rblod $
  5. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  6. !!----------------------------------------------------------------------
  7. SUBROUTINE agrif_user
  8. END SUBROUTINE agrif_user
  9. SUBROUTINE agrif_before_regridding
  10. END SUBROUTINE agrif_before_regridding
  11. SUBROUTINE Agrif_InitWorkspace
  12. !!----------------------------------------------------------------------
  13. !! *** ROUTINE Agrif_InitWorkspace ***
  14. !!----------------------------------------------------------------------
  15. USE par_oce
  16. USE dom_oce
  17. USE nemogcm
  18. !
  19. IMPLICIT NONE
  20. !!----------------------------------------------------------------------
  21. !
  22. IF( .NOT. Agrif_Root() ) THEN
  23. jpni = Agrif_Parent(jpni)
  24. jpnj = Agrif_Parent(jpnj)
  25. jpnij = Agrif_Parent(jpnij)
  26. jpiglo = nbcellsx + 2 + 2*nbghostcells
  27. jpjglo = nbcellsy + 2 + 2*nbghostcells
  28. jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
  29. jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
  30. ! JC: change to allow for different vertical levels
  31. ! jpk is already set
  32. ! keep it jpk possibly different from jpkdta which
  33. ! hold parent grid vertical levels number (set earlier)
  34. ! jpk = jpkdta
  35. jpim1 = jpi-1
  36. jpjm1 = jpj-1
  37. jpkm1 = jpk-1
  38. jpij = jpi*jpj
  39. jpidta = jpiglo
  40. jpjdta = jpjglo
  41. jpizoom = 1
  42. jpjzoom = 1
  43. nperio = 0
  44. jperio = 0
  45. ENDIF
  46. !
  47. END SUBROUTINE Agrif_InitWorkspace
  48. SUBROUTINE Agrif_InitValues
  49. !!----------------------------------------------------------------------
  50. !! *** ROUTINE Agrif_InitValues ***
  51. !!
  52. !! ** Purpose :: Declaration of variables to be interpolated
  53. !!----------------------------------------------------------------------
  54. USE Agrif_Util
  55. USE oce
  56. USE dom_oce
  57. USE nemogcm
  58. USE tradmp
  59. USE bdy_par
  60. IMPLICIT NONE
  61. !!----------------------------------------------------------------------
  62. ! 0. Initializations
  63. !-------------------
  64. IF( cp_cfg == 'orca' ) THEN
  65. IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
  66. & .OR. jp_cfg == 4 ) THEN
  67. jp_cfg = -1 ! set special value for jp_cfg on fine grids
  68. cp_cfg = "default"
  69. ENDIF
  70. ENDIF
  71. ! Specific fine grid Initializations
  72. ! no tracer damping on fine grids
  73. ln_tradmp = .FALSE.
  74. ! no open boundary on fine grids
  75. lk_bdy = .FALSE.
  76. CALL nemo_init ! Initializations of each fine grid
  77. CALL agrif_nemo_init
  78. CALL Agrif_InitValues_cont_dom
  79. # if ! defined key_offline
  80. CALL Agrif_InitValues_cont
  81. # endif
  82. # if defined key_top
  83. CALL Agrif_InitValues_cont_top
  84. # endif
  85. END SUBROUTINE Agrif_initvalues
  86. SUBROUTINE Agrif_InitValues_cont_dom
  87. !!----------------------------------------------------------------------
  88. !! *** ROUTINE Agrif_InitValues_cont ***
  89. !!
  90. !! ** Purpose :: Declaration of variables to be interpolated
  91. !!----------------------------------------------------------------------
  92. USE Agrif_Util
  93. USE oce
  94. USE dom_oce
  95. USE nemogcm
  96. USE sol_oce
  97. USE in_out_manager
  98. USE agrif_opa_update
  99. USE agrif_opa_interp
  100. USE agrif_opa_sponge
  101. !
  102. IMPLICIT NONE
  103. !
  104. !!----------------------------------------------------------------------
  105. ! Declaration of the type of variable which have to be interpolated
  106. !---------------------------------------------------------------------
  107. CALL agrif_declare_var_dom
  108. !
  109. END SUBROUTINE Agrif_InitValues_cont_dom
  110. SUBROUTINE agrif_declare_var_dom
  111. !!----------------------------------------------------------------------
  112. !! *** ROUTINE agrif_declare_var ***
  113. !!
  114. !! ** Purpose :: Declaration of variables to be interpolated
  115. !!----------------------------------------------------------------------
  116. USE agrif_util
  117. USE par_oce
  118. USE oce
  119. IMPLICIT NONE
  120. !!----------------------------------------------------------------------
  121. ! 1. Declaration of the type of variable which have to be interpolated
  122. !---------------------------------------------------------------------
  123. CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
  124. CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
  125. ! 2. Type of interpolation
  126. !-------------------------
  127. CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  128. CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  129. ! 3. Location of interpolation
  130. !-----------------------------
  131. CALL Agrif_Set_bc(e1u_id,(/0,0/))
  132. CALL Agrif_Set_bc(e2v_id,(/0,0/))
  133. ! 5. Update type
  134. !---------------
  135. CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
  136. CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
  137. ! High order updates
  138. ! CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
  139. ! CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
  140. !
  141. END SUBROUTINE agrif_declare_var_dom
  142. # if ! defined key_offline
  143. SUBROUTINE Agrif_InitValues_cont
  144. !!----------------------------------------------------------------------
  145. !! *** ROUTINE Agrif_InitValues_cont ***
  146. !!
  147. !! ** Purpose :: Declaration of variables to be interpolated
  148. !!----------------------------------------------------------------------
  149. USE Agrif_Util
  150. USE oce
  151. USE dom_oce
  152. USE nemogcm
  153. USE sol_oce
  154. USE lib_mpp
  155. USE in_out_manager
  156. USE agrif_opa_update
  157. USE agrif_opa_interp
  158. USE agrif_opa_sponge
  159. !
  160. IMPLICIT NONE
  161. !
  162. LOGICAL :: check_namelist
  163. CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
  164. !!----------------------------------------------------------------------
  165. ! 1. Declaration of the type of variable which have to be interpolated
  166. !---------------------------------------------------------------------
  167. CALL agrif_declare_var
  168. ! 2. First interpolations of potentially non zero fields
  169. !-------------------------------------------------------
  170. Agrif_SpecialValue=0.
  171. Agrif_UseSpecialValue = .TRUE.
  172. CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
  173. CALL Agrif_Sponge
  174. tabspongedone_tsn = .FALSE.
  175. CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
  176. ! reset tsa to zero
  177. tsa(:,:,:,:) = 0.
  178. Agrif_UseSpecialValue = ln_spc_dyn
  179. CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
  180. CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
  181. tabspongedone_u = .FALSE.
  182. tabspongedone_v = .FALSE.
  183. CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
  184. tabspongedone_u = .FALSE.
  185. tabspongedone_v = .FALSE.
  186. CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
  187. #if defined key_dynspg_ts
  188. Agrif_UseSpecialValue = .TRUE.
  189. CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
  190. Agrif_UseSpecialValue = ln_spc_dyn
  191. CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
  192. CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
  193. CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
  194. CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
  195. ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
  196. ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0
  197. ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0
  198. ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
  199. #endif
  200. Agrif_UseSpecialValue = .FALSE.
  201. ! reset velocities to zero
  202. ua(:,:,:) = 0.
  203. va(:,:,:) = 0.
  204. ! 3. Some controls
  205. !-----------------
  206. check_namelist = .TRUE.
  207. IF( check_namelist ) THEN
  208. ! Check time steps
  209. IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
  210. WRITE(cl_check1,*) NINT(Agrif_Parent(rdt))
  211. WRITE(cl_check2,*) NINT(rdt)
  212. WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot())
  213. CALL ctl_stop( 'incompatible time step between grids', &
  214. & 'parent grid value : '//cl_check1 , &
  215. & 'child grid value : '//cl_check2 , &
  216. & 'value on child grid must be changed to : '//cl_check3 )
  217. ! rdt=Agrif_Parent(rdt)/Agrif_Rhot()
  218. ENDIF
  219. ! Check run length
  220. IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
  221. Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
  222. WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
  223. WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()
  224. CALL ctl_warn( 'incompatible run length between grids' , &
  225. & ' nit000 on fine grid will be changed to : '//cl_check1, &
  226. & ' nitend on fine grid will be changed to : '//cl_check2 )
  227. nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
  228. nitend = Agrif_Parent(nitend) *Agrif_IRhot()
  229. ENDIF
  230. ! Check coordinates
  231. IF( ln_zps ) THEN
  232. ! check parameters for partial steps
  233. IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
  234. WRITE(*,*) 'incompatible e3zps_min between grids'
  235. WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
  236. WRITE(*,*) 'child grid :',e3zps_min
  237. WRITE(*,*) 'those values should be identical'
  238. STOP
  239. ENDIF
  240. IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
  241. WRITE(*,*) 'incompatible e3zps_rat between grids'
  242. WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
  243. WRITE(*,*) 'child grid :',e3zps_rat
  244. WRITE(*,*) 'those values should be identical'
  245. STOP
  246. ENDIF
  247. ENDIF
  248. ! check if masks and bathymetries match
  249. IF(ln_chk_bathy) THEN
  250. !
  251. IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
  252. !
  253. kindic_agr = 0
  254. ! check if umask agree with parent along western and eastern boundaries:
  255. CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
  256. ! check if vmask agree with parent along northern and southern boundaries:
  257. CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
  258. ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
  259. CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
  260. !
  261. IF (lk_mpp) CALL mpp_sum( kindic_agr )
  262. IF( kindic_agr /= 0 ) THEN
  263. CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
  264. ELSE
  265. IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
  266. END IF
  267. ENDIF
  268. !
  269. ENDIF
  270. !
  271. ! Do update at initialisation because not done before writing restarts
  272. ! This would indeed change boundary conditions values at initial time
  273. ! hence produce restartability issues.
  274. ! Note that update below is recursive (with lk_agrif_doupd=T):
  275. !
  276. ! JC: I am not sure if Agrif_MaxLevel() is the "relative"
  277. ! or the absolute maximum nesting level...TBC
  278. IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN
  279. ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
  280. CALL Agrif_Update_tra()
  281. CALL Agrif_Update_dyn()
  282. ENDIF
  283. !
  284. # if defined key_zdftke
  285. ! CALL Agrif_Update_tke(0)
  286. # endif
  287. !
  288. Agrif_UseSpecialValueInUpdate = .FALSE.
  289. nbcline = 0
  290. lk_agrif_doupd = .FALSE.
  291. !
  292. END SUBROUTINE Agrif_InitValues_cont
  293. SUBROUTINE agrif_declare_var
  294. !!----------------------------------------------------------------------
  295. !! *** ROUTINE agrif_declarE_var ***
  296. !!
  297. !! ** Purpose :: Declaration of variables to be interpolated
  298. !!----------------------------------------------------------------------
  299. USE agrif_util
  300. USE par_oce ! ONLY : jpts
  301. USE oce
  302. USE agrif_oce
  303. IMPLICIT NONE
  304. !!----------------------------------------------------------------------
  305. ! 1. Declaration of the type of variable which have to be interpolated
  306. !---------------------------------------------------------------------
  307. CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
  308. CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
  309. CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
  310. CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
  311. CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
  312. CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
  313. CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
  314. CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
  315. CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
  316. CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
  317. CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
  318. CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
  319. CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
  320. CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
  321. CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
  322. CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
  323. CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
  324. CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
  325. CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
  326. # if defined key_zdftke
  327. CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
  328. CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
  329. CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
  330. # endif
  331. ! 2. Type of interpolation
  332. !-------------------------
  333. CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
  334. CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  335. CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  336. CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
  337. CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
  338. CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  339. CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  340. CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  341. CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  342. CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  343. CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  344. CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
  345. CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
  346. CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
  347. # if defined key_zdftke
  348. CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
  349. # endif
  350. ! 3. Location of interpolation
  351. !-----------------------------
  352. CALL Agrif_Set_bc(tsn_id,(/0,1/))
  353. CALL Agrif_Set_bc(un_interp_id,(/0,1/))
  354. CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
  355. ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
  356. ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
  357. ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
  358. CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
  359. CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
  360. CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
  361. CALL Agrif_Set_bc(sshn_id,(/0,0/))
  362. CALL Agrif_Set_bc(unb_id ,(/0,0/))
  363. CALL Agrif_Set_bc(vnb_id ,(/0,0/))
  364. CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
  365. CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
  366. CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9
  367. CALL Agrif_Set_bc(umsk_id,(/0,0/))
  368. CALL Agrif_Set_bc(vmsk_id,(/0,0/))
  369. # if defined key_zdftke
  370. CALL Agrif_Set_bc(avm_id ,(/0,1/))
  371. # endif
  372. ! 5. Update type
  373. !---------------
  374. CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
  375. CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
  376. CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
  377. CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
  378. CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
  379. CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
  380. CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
  381. # if defined key_zdftke
  382. CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
  383. CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
  384. CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
  385. # endif
  386. ! High order updates
  387. ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
  388. ! CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
  389. ! CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
  390. !
  391. ! CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
  392. ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
  393. ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
  394. !
  395. END SUBROUTINE agrif_declare_var
  396. # endif
  397. # if defined key_lim2
  398. SUBROUTINE Agrif_InitValues_cont_lim2
  399. !!----------------------------------------------------------------------
  400. !! *** ROUTINE Agrif_InitValues_cont_lim2 ***
  401. !!
  402. !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
  403. !!----------------------------------------------------------------------
  404. USE Agrif_Util
  405. USE ice_2
  406. USE agrif_ice
  407. USE in_out_manager
  408. USE agrif_lim2_update
  409. USE agrif_lim2_interp
  410. USE lib_mpp
  411. !
  412. IMPLICIT NONE
  413. !
  414. !!----------------------------------------------------------------------
  415. ! 1. Declaration of the type of variable which have to be interpolated
  416. !---------------------------------------------------------------------
  417. CALL agrif_declare_var_lim2
  418. ! 2. First interpolations of potentially non zero fields
  419. !-------------------------------------------------------
  420. Agrif_SpecialValue=-9999.
  421. Agrif_UseSpecialValue = .TRUE.
  422. ! Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
  423. ! Call Agrif_Bc_variable(zvel ,u_ice_id ,calledweight=1.,procname=interp_u_ice )
  424. ! Call Agrif_Bc_variable(zvel ,v_ice_id ,calledweight=1.,procname=interp_v_ice )
  425. Agrif_SpecialValue=0.
  426. Agrif_UseSpecialValue = .FALSE.
  427. ! 3. Some controls
  428. !-----------------
  429. # if ! defined key_lim2_vp
  430. lim_nbstep = 1.
  431. CALL agrif_rhg_lim2_load
  432. CALL agrif_trp_lim2_load
  433. lim_nbstep = 0.
  434. # endif
  435. !RB mandatory but why ???
  436. ! IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
  437. ! CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
  438. ! nbclineupdate = nn_fsbc
  439. ! ENDIF
  440. CALL Agrif_Update_lim2(0)
  441. !
  442. END SUBROUTINE Agrif_InitValues_cont_lim2
  443. SUBROUTINE agrif_declare_var_lim2
  444. !!----------------------------------------------------------------------
  445. !! *** ROUTINE agrif_declare_var_lim2 ***
  446. !!
  447. !! ** Purpose :: Declaration of variables to be interpolated for LIM2
  448. !!----------------------------------------------------------------------
  449. USE agrif_util
  450. USE ice_2
  451. IMPLICIT NONE
  452. !!----------------------------------------------------------------------
  453. ! 1. Declaration of the type of variable which have to be interpolated
  454. !---------------------------------------------------------------------
  455. CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
  456. # if defined key_lim2_vp
  457. CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
  458. CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
  459. # else
  460. CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
  461. CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
  462. # endif
  463. ! 2. Type of interpolation
  464. !-------------------------
  465. CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
  466. CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
  467. CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
  468. ! 3. Location of interpolation
  469. !-----------------------------
  470. CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
  471. CALL Agrif_Set_bc(u_ice_id,(/0,1/))
  472. CALL Agrif_Set_bc(v_ice_id,(/0,1/))
  473. ! 5. Update type
  474. !---------------
  475. CALL Agrif_Set_Updatetype(adv_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. !
  479. END SUBROUTINE agrif_declare_var_lim2
  480. # endif
  481. # if defined key_top
  482. SUBROUTINE Agrif_InitValues_cont_top
  483. !!----------------------------------------------------------------------
  484. !! *** ROUTINE Agrif_InitValues_cont_top ***
  485. !!
  486. !! ** Purpose :: Declaration of variables to be interpolated
  487. !!----------------------------------------------------------------------
  488. USE Agrif_Util
  489. USE oce
  490. USE dom_oce
  491. USE nemogcm
  492. USE par_trc
  493. USE lib_mpp
  494. USE trc
  495. USE in_out_manager
  496. USE agrif_opa_sponge
  497. USE agrif_top_update
  498. USE agrif_top_interp
  499. USE agrif_top_sponge
  500. !
  501. IMPLICIT NONE
  502. !
  503. CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
  504. LOGICAL :: check_namelist
  505. !!----------------------------------------------------------------------
  506. ! 1. Declaration of the type of variable which have to be interpolated
  507. !---------------------------------------------------------------------
  508. CALL agrif_declare_var_top
  509. ! 2. First interpolations of potentially non zero fields
  510. !-------------------------------------------------------
  511. Agrif_SpecialValue=0.
  512. Agrif_UseSpecialValue = .TRUE.
  513. CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
  514. Agrif_UseSpecialValue = .FALSE.
  515. CALL Agrif_Sponge
  516. tabspongedone_trn = .FALSE.
  517. CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
  518. ! reset tsa to zero
  519. tra(:,:,:,:) = 0.
  520. ! 3. Some controls
  521. !-----------------
  522. check_namelist = .TRUE.
  523. IF( check_namelist ) THEN
  524. # if defined key_offline
  525. ! Check time steps
  526. IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
  527. WRITE(cl_check1,*) Agrif_Parent(rdt)
  528. WRITE(cl_check2,*) rdt
  529. WRITE(cl_check3,*) rdt*Agrif_Rhot()
  530. CALL ctl_stop( 'incompatible time step between grids', &
  531. & 'parent grid value : '//cl_check1 , &
  532. & 'child grid value : '//cl_check2 , &
  533. & 'value on child grid must be changed to &
  534. & :'//cl_check3 )
  535. ! rdt=rdt*Agrif_Rhot()
  536. ENDIF
  537. ! Check run length
  538. IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
  539. Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
  540. WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
  541. WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()
  542. CALL ctl_warn( 'incompatible run length between grids' , &
  543. & ' nit000 on fine grid will be changed to : '//cl_check1, &
  544. & ' nitend on fine grid will be changed to : '//cl_check2 )
  545. nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
  546. nitend = Agrif_Parent(nitend) *Agrif_IRhot()
  547. ENDIF
  548. ! Check coordinates
  549. IF( ln_zps ) THEN
  550. ! check parameters for partial steps
  551. IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
  552. WRITE(*,*) 'incompatible e3zps_min between grids'
  553. WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
  554. WRITE(*,*) 'child grid :',e3zps_min
  555. WRITE(*,*) 'those values should be identical'
  556. STOP
  557. ENDIF
  558. IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
  559. WRITE(*,*) 'incompatible e3zps_rat between grids'
  560. WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
  561. WRITE(*,*) 'child grid :',e3zps_rat
  562. WRITE(*,*) 'those values should be identical'
  563. STOP
  564. ENDIF
  565. ENDIF
  566. # endif
  567. ! Check passive tracer cell
  568. IF( nn_dttrc .NE. 1 ) THEN
  569. WRITE(*,*) 'nn_dttrc should be equal to 1'
  570. ENDIF
  571. ENDIF
  572. CALL Agrif_Update_trc(0)
  573. !
  574. Agrif_UseSpecialValueInUpdate = .FALSE.
  575. nbcline_trc = 0
  576. !
  577. END SUBROUTINE Agrif_InitValues_cont_top
  578. SUBROUTINE agrif_declare_var_top
  579. !!----------------------------------------------------------------------
  580. !! *** ROUTINE agrif_declare_var_top ***
  581. !!
  582. !! ** Purpose :: Declaration of TOP variables to be interpolated
  583. !!----------------------------------------------------------------------
  584. USE agrif_util
  585. USE agrif_oce
  586. USE dom_oce
  587. USE trc
  588. IMPLICIT NONE
  589. ! 1. Declaration of the type of variable which have to be interpolated
  590. !---------------------------------------------------------------------
  591. 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)
  592. 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)
  593. ! 2. Type of interpolation
  594. !-------------------------
  595. CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
  596. CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
  597. ! 3. Location of interpolation
  598. !-----------------------------
  599. CALL Agrif_Set_bc(trn_id,(/0,1/))
  600. ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
  601. CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
  602. ! 5. Update type
  603. !---------------
  604. CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
  605. ! Higher order update
  606. ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
  607. !
  608. END SUBROUTINE agrif_declare_var_top
  609. # endif
  610. SUBROUTINE Agrif_detect( kg, ksizex )
  611. !!----------------------------------------------------------------------
  612. !! *** ROUTINE Agrif_detect ***
  613. !!----------------------------------------------------------------------
  614. !
  615. INTEGER, DIMENSION(2) :: ksizex
  616. INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
  617. !!----------------------------------------------------------------------
  618. !
  619. RETURN
  620. !
  621. END SUBROUTINE Agrif_detect
  622. SUBROUTINE agrif_nemo_init
  623. !!----------------------------------------------------------------------
  624. !! *** ROUTINE agrif_init ***
  625. !!----------------------------------------------------------------------
  626. USE agrif_oce
  627. USE agrif_ice
  628. USE in_out_manager
  629. USE lib_mpp
  630. IMPLICIT NONE
  631. !
  632. INTEGER :: ios ! Local integer output status for namelist read
  633. INTEGER :: iminspon
  634. NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
  635. !!--------------------------------------------------------------------------------------
  636. !
  637. REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom
  638. READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
  639. 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
  640. REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom
  641. READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
  642. 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
  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,*) ' baroclinic update frequency nn_cln_update = ', nn_cln_update
  651. WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s'
  652. WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' 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. WRITE(numout,*)
  656. ENDIF
  657. !
  658. ! convert DOCTOR namelist name into OLD names
  659. nbclineupdate = nn_cln_update
  660. visc_tra = rn_sponge_tra
  661. visc_dyn = rn_sponge_dyn
  662. !
  663. ! Check sponge length:
  664. iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
  665. IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
  666. IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large')
  667. !
  668. IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
  669. # if defined key_lim2
  670. IF( agrif_ice_alloc() > 0 ) CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
  671. # endif
  672. !
  673. END SUBROUTINE agrif_nemo_init
  674. # if defined key_mpp_mpi
  675. SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
  676. !!----------------------------------------------------------------------
  677. !! *** ROUTINE Agrif_detect ***
  678. !!----------------------------------------------------------------------
  679. USE dom_oce
  680. IMPLICIT NONE
  681. !
  682. INTEGER :: indglob, indloc, nprocloc, i
  683. !!----------------------------------------------------------------------
  684. !
  685. SELECT CASE( i )
  686. CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1
  687. CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1
  688. CASE DEFAULT
  689. indglob = indloc
  690. END SELECT
  691. !
  692. END SUBROUTINE Agrif_InvLoc
  693. SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
  694. !!----------------------------------------------------------------------
  695. !! *** ROUTINE Agrif_get_proc_info ***
  696. !!----------------------------------------------------------------------
  697. USE par_oce
  698. IMPLICIT NONE
  699. !
  700. INTEGER, INTENT(out) :: imin, imax
  701. INTEGER, INTENT(out) :: jmin, jmax
  702. !!----------------------------------------------------------------------
  703. !
  704. imin = nimppt(Agrif_Procrank+1) ! ?????
  705. jmin = njmppt(Agrif_Procrank+1) ! ?????
  706. imax = imin + jpi - 1
  707. jmax = jmin + jpj - 1
  708. !
  709. END SUBROUTINE Agrif_get_proc_info
  710. SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
  711. !!----------------------------------------------------------------------
  712. !! *** ROUTINE Agrif_estimate_parallel_cost ***
  713. !!----------------------------------------------------------------------
  714. USE par_oce
  715. IMPLICIT NONE
  716. !
  717. INTEGER, INTENT(in) :: imin, imax
  718. INTEGER, INTENT(in) :: jmin, jmax
  719. INTEGER, INTENT(in) :: nbprocs
  720. REAL(wp), INTENT(out) :: grid_cost
  721. !!----------------------------------------------------------------------
  722. !
  723. grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
  724. !
  725. END SUBROUTINE Agrif_estimate_parallel_cost
  726. # endif
  727. #else
  728. SUBROUTINE Subcalledbyagrif
  729. !!----------------------------------------------------------------------
  730. !! *** ROUTINE Subcalledbyagrif ***
  731. !!----------------------------------------------------------------------
  732. WRITE(*,*) 'Impossible to be here'
  733. END SUBROUTINE Subcalledbyagrif
  734. #endif