flo4rk.F90 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469
  1. MODULE flo4rk
  2. !!======================================================================
  3. !! *** MODULE flo4rk ***
  4. !! Ocean floats : trajectory computation using a 4th order Runge-Kutta
  5. !!======================================================================
  6. #if defined key_floats || defined key_esopa
  7. !!----------------------------------------------------------------------
  8. !! 'key_floats' float trajectories
  9. !!----------------------------------------------------------------------
  10. !! flo_4rk : Compute the geographical position of floats
  11. !! flo_interp : interpolation
  12. !!----------------------------------------------------------------------
  13. USE flo_oce ! ocean drifting floats
  14. USE oce ! ocean dynamics and tracers
  15. USE dom_oce ! ocean space and time domain
  16. USE in_out_manager ! I/O manager
  17. USE wrk_nemo ! working array
  18. IMPLICIT NONE
  19. PRIVATE
  20. PUBLIC flo_4rk ! routine called by floats.F90
  21. ! ! RK4 and Lagrange interpolation coefficients
  22. REAL(wp), DIMENSION (4) :: tcoef1 = (/ 1.0 , 0.5 , 0.5 , 0.0 /) !
  23. REAL(wp), DIMENSION (4) :: tcoef2 = (/ 0.0 , 0.5 , 0.5 , 1.0 /) !
  24. REAL(wp), DIMENSION (4) :: scoef2 = (/ 1.0 , 2.0 , 2.0 , 1.0 /) !
  25. REAL(wp), DIMENSION (4) :: rcoef = (/-1./6. , 1./2. ,-1./2. , 1./6. /) !
  26. REAL(wp), DIMENSION (3) :: scoef1 = (/ 0.5 , 0.5 , 1.0 /) !
  27. !! * Substitutions
  28. # include "domzgr_substitute.h90"
  29. !!----------------------------------------------------------------------
  30. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  31. !! $Id: flo4rk.F90 3294 2012-01-28 16:44:18Z rblod $
  32. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  33. !!----------------------------------------------------------------------
  34. CONTAINS
  35. SUBROUTINE flo_4rk( kt )
  36. !!----------------------------------------------------------------------
  37. !! *** ROUTINE flo_4rk ***
  38. !!
  39. !! ** Purpose : Compute the geographical position (lat,lon,depth)
  40. !! of each float at each time step.
  41. !!
  42. !! ** Method : The position of a float is computed with a 4th order
  43. !! Runge-Kutta scheme and and Lagrange interpolation.
  44. !! We need to know the velocity field, the old positions of the
  45. !! floats and the grid defined on the domain.
  46. !!----------------------------------------------------------------------
  47. INTEGER, INTENT(in) :: kt ! ocean time-step index
  48. !!
  49. INTEGER :: jfl, jind ! dummy loop indices
  50. INTEGER :: ierror ! error value
  51. REAL(wp), POINTER, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions
  52. REAL(wp), POINTER, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position
  53. REAL(wp), POINTER, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients
  54. !!---------------------------------------------------------------------
  55. CALL wrk_alloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl)
  56. CALL wrk_alloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )
  57. !
  58. IF( ierror /= 0 ) THEN
  59. WRITE(numout,*) 'flo_4rk: allocation of workspace arrays failed'
  60. ENDIF
  61. IF( kt == nit000 ) THEN
  62. IF(lwp) WRITE(numout,*)
  63. IF(lwp) WRITE(numout,*) 'flo_4rk : compute Runge Kutta trajectories for floats '
  64. IF(lwp) WRITE(numout,*) '~~~~~~~'
  65. ENDIF
  66. ! Verification of the floats positions. If one of them leave the domain
  67. ! domain we replace the float near the border.
  68. DO jfl = 1, jpnfl
  69. ! i-direction
  70. IF( tpifl(jfl) <= 1.5 ) THEN
  71. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  72. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the WEST border.'
  73. tpifl(jfl) = tpifl(jfl) + 1.
  74. IF(lwp)WRITE(numout,*)'New initialisation for this float at i=',tpifl(jfl)
  75. ENDIF
  76. IF( tpifl(jfl) >= jpi-.5 ) THEN
  77. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  78. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the EAST border.'
  79. tpifl(jfl) = tpifl(jfl) - 1.
  80. IF(lwp)WRITE(numout,*)'New initialisation for this float at i=', tpifl(jfl)
  81. ENDIF
  82. ! j-direction
  83. IF( tpjfl(jfl) <= 1.5 ) THEN
  84. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  85. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the SOUTH border.'
  86. tpjfl(jfl) = tpjfl(jfl) + 1.
  87. IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
  88. ENDIF
  89. IF( tpjfl(jfl) >= jpj-.5 ) THEN
  90. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  91. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the NORTH border.'
  92. tpjfl(jfl) = tpjfl(jfl) - 1.
  93. IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
  94. ENDIF
  95. ! k-direction
  96. IF( tpkfl(jfl) <= .5 ) THEN
  97. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  98. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the TOP border.'
  99. tpkfl(jfl) = tpkfl(jfl) + 1.
  100. IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
  101. ENDIF
  102. IF( tpkfl(jfl) >= jpk-.5 ) THEN
  103. IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
  104. IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the BOTTOM border.'
  105. tpkfl(jfl) = tpkfl(jfl) - 1.
  106. IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
  107. ENDIF
  108. END DO
  109. ! 4 steps of Runge-Kutta algorithme
  110. ! initialisation of the positions
  111. DO jfl = 1, jpnfl
  112. zgifl(jfl) = tpifl(jfl)
  113. zgjfl(jfl) = tpjfl(jfl)
  114. zgkfl(jfl) = tpkfl(jfl)
  115. END DO
  116. DO jind = 1, 4
  117. ! for each step we compute the compute the velocity with Lagrange interpolation
  118. CALL flo_interp( zgifl, zgjfl, zgkfl, zufl, zvfl, zwfl, jind )
  119. ! computation of Runge-Kutta factor
  120. DO jfl = 1, jpnfl
  121. zrkxfl(jfl,jind) = rdt*zufl(jfl)
  122. zrkyfl(jfl,jind) = rdt*zvfl(jfl)
  123. zrkzfl(jfl,jind) = rdt*zwfl(jfl)
  124. END DO
  125. IF( jind /= 4 ) THEN
  126. DO jfl = 1, jpnfl
  127. zgifl(jfl) = (tpifl(jfl)) + scoef1(jind)*zrkxfl(jfl,jind)
  128. zgjfl(jfl) = (tpjfl(jfl)) + scoef1(jind)*zrkyfl(jfl,jind)
  129. zgkfl(jfl) = (tpkfl(jfl)) + scoef1(jind)*zrkzfl(jfl,jind)
  130. END DO
  131. ENDIF
  132. END DO
  133. DO jind = 1, 4
  134. DO jfl = 1, jpnfl
  135. tpifl(jfl) = tpifl(jfl) + scoef2(jind)*zrkxfl(jfl,jind)/6.
  136. tpjfl(jfl) = tpjfl(jfl) + scoef2(jind)*zrkyfl(jfl,jind)/6.
  137. tpkfl(jfl) = tpkfl(jfl) + scoef2(jind)*zrkzfl(jfl,jind)/6.
  138. END DO
  139. END DO
  140. !
  141. CALL wrk_dealloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl)
  142. CALL wrk_dealloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )
  143. !
  144. END SUBROUTINE flo_4rk
  145. SUBROUTINE flo_interp( pxt , pyt , pzt , &
  146. & pufl, pvfl, pwfl, ki )
  147. !!----------------------------------------------------------------------
  148. !! *** ROUTINE flointerp ***
  149. !!
  150. !! ** Purpose : Interpolation of the velocity on the float position
  151. !!
  152. !! ** Method : Lagrange interpolation with the 64 neighboring
  153. !! points. This routine is call 4 time at each time step to
  154. !! compute velocity at the date and the position we need to
  155. !! integrated with RK method.
  156. !!----------------------------------------------------------------------
  157. REAL(wp) , DIMENSION(jpnfl), INTENT(in ) :: pxt , pyt , pzt ! position of the float
  158. REAL(wp) , DIMENSION(jpnfl), INTENT( out) :: pufl, pvfl, pwfl ! velocity at this position
  159. INTEGER , INTENT(in ) :: ki !
  160. !!
  161. INTEGER :: jfl, jind1, jind2, jind3 ! dummy loop indices
  162. REAL(wp) :: zsumu, zsumv, zsumw ! local scalar
  163. INTEGER , POINTER, DIMENSION(:) :: iilu, ijlu, iklu ! nearest neighbour INDEX-u
  164. INTEGER , POINTER, DIMENSION(:) :: iilv, ijlv, iklv ! nearest neighbour INDEX-v
  165. INTEGER , POINTER, DIMENSION(:) :: iilw, ijlw, iklw ! nearest neighbour INDEX-w
  166. INTEGER , POINTER, DIMENSION(:,:) :: iidu, ijdu, ikdu ! 64 nearest neighbour INDEX-u
  167. INTEGER , POINTER, DIMENSION(:,:) :: iidv, ijdv, ikdv ! 64 nearest neighbour INDEX-v
  168. INTEGER , POINTER, DIMENSION(:,:) :: iidw, ijdw, ikdw ! 64 nearest neighbour INDEX-w
  169. REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxu, zlagyu, zlagzu ! Lagrange coefficients
  170. REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxv, zlagyv, zlagzv ! - -
  171. REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxw, zlagyw, zlagzw ! - -
  172. REAL(wp) , POINTER, DIMENSION(:,:,:,:) :: ztufl , ztvfl , ztwfl ! velocity at choosen time step
  173. !!---------------------------------------------------------------------
  174. CALL wrk_alloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )
  175. CALL wrk_alloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )
  176. CALL wrk_alloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )
  177. CALL wrk_alloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )
  178. ! Interpolation of U velocity
  179. ! nearest neightboring point for computation of u
  180. DO jfl = 1, jpnfl
  181. iilu(jfl) = INT(pxt(jfl)-.5)
  182. ijlu(jfl) = INT(pyt(jfl)-.5)
  183. iklu(jfl) = INT(pzt(jfl))
  184. END DO
  185. ! 64 neightboring points for computation of u
  186. DO jind1 = 1, 4
  187. DO jfl = 1, jpnfl
  188. ! i-direction
  189. IF( iilu(jfl) <= 2 ) THEN ; iidu(jfl,jind1) = jind1
  190. ELSE
  191. IF( iilu(jfl) >= jpi-1 ) THEN ; iidu(jfl,jind1) = jpi + jind1 - 4
  192. ELSE ; iidu(jfl,jind1) = iilu(jfl) + jind1 - 2
  193. ENDIF
  194. ENDIF
  195. ! j-direction
  196. IF( ijlu(jfl) <= 2 ) THEN ; ijdu(jfl,jind1) = jind1
  197. ELSE
  198. IF( ijlu(jfl) >= jpj-1 ) THEN ; ijdu(jfl,jind1) = jpj + jind1 - 4
  199. ELSE ; ijdu(jfl,jind1) = ijlu(jfl) + jind1 - 2
  200. ENDIF
  201. ENDIF
  202. ! k-direction
  203. IF( iklu(jfl) <= 2 ) THEN ; ikdu(jfl,jind1) = jind1
  204. ELSE
  205. IF( iklu(jfl) >= jpk-1 ) THEN ; ikdu(jfl,jind1) = jpk + jind1 - 4
  206. ELSE ; ikdu(jfl,jind1) = iklu(jfl) + jind1 - 2
  207. ENDIF
  208. ENDIF
  209. END DO
  210. END DO
  211. ! Lagrange coefficients
  212. DO jfl = 1, jpnfl
  213. DO jind1 = 1, 4
  214. zlagxu(jfl,jind1) = 1.
  215. zlagyu(jfl,jind1) = 1.
  216. zlagzu(jfl,jind1) = 1.
  217. END DO
  218. END DO
  219. DO jind1 = 1, 4
  220. DO jind2 = 1, 4
  221. DO jfl= 1, jpnfl
  222. IF( jind1 /= jind2 ) THEN
  223. zlagxu(jfl,jind1) = zlagxu(jfl,jind1) * ( pxt(jfl)-(float(iidu(jfl,jind2))+.5) )
  224. zlagyu(jfl,jind1) = zlagyu(jfl,jind1) * ( pyt(jfl)-(float(ijdu(jfl,jind2))) )
  225. zlagzu(jfl,jind1) = zlagzu(jfl,jind1) * ( pzt(jfl)-(float(ikdu(jfl,jind2))) )
  226. ENDIF
  227. END DO
  228. END DO
  229. END DO
  230. ! velocity when we compute at middle time step
  231. DO jfl = 1, jpnfl
  232. DO jind1 = 1, 4
  233. DO jind2 = 1, 4
  234. DO jind3 = 1, 4
  235. ztufl(jfl,jind1,jind2,jind3) = &
  236. & ( tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) + &
  237. & tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) ) &
  238. & / e1u(iidu(jfl,jind1),ijdu(jfl,jind2))
  239. END DO
  240. END DO
  241. END DO
  242. zsumu = 0.
  243. DO jind1 = 1, 4
  244. DO jind2 = 1, 4
  245. DO jind3 = 1, 4
  246. zsumu = zsumu + ztufl(jfl,jind1,jind2,jind3) * zlagxu(jfl,jind1) * zlagyu(jfl,jind2) &
  247. & * zlagzu(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
  248. END DO
  249. END DO
  250. END DO
  251. pufl(jfl) = zsumu
  252. END DO
  253. ! Interpolation of V velocity
  254. ! nearest neightboring point for computation of v
  255. DO jfl = 1, jpnfl
  256. iilv(jfl) = INT(pxt(jfl)-.5)
  257. ijlv(jfl) = INT(pyt(jfl)-.5)
  258. iklv(jfl) = INT(pzt(jfl))
  259. END DO
  260. ! 64 neightboring points for computation of v
  261. DO jind1 = 1, 4
  262. DO jfl = 1, jpnfl
  263. ! i-direction
  264. IF( iilv(jfl) <= 2 ) THEN ; iidv(jfl,jind1) = jind1
  265. ELSE
  266. IF( iilv(jfl) >= jpi-1 ) THEN ; iidv(jfl,jind1) = jpi + jind1 - 4
  267. ELSE ; iidv(jfl,jind1) = iilv(jfl) + jind1 - 2
  268. ENDIF
  269. ENDIF
  270. ! j-direction
  271. IF( ijlv(jfl) <= 2 ) THEN ; ijdv(jfl,jind1) = jind1
  272. ELSE
  273. IF( ijlv(jfl) >= jpj-1 ) THEN ; ijdv(jfl,jind1) = jpj + jind1 - 4
  274. ELSE ; ijdv(jfl,jind1) = ijlv(jfl) + jind1 - 2
  275. ENDIF
  276. ENDIF
  277. ! k-direction
  278. IF( iklv(jfl) <= 2 ) THEN ; ikdv(jfl,jind1) = jind1
  279. ELSE
  280. IF( iklv(jfl) >= jpk-1 ) THEN ; ikdv(jfl,jind1) = jpk + jind1 - 4
  281. ELSE ; ikdv(jfl,jind1) = iklv(jfl) + jind1 - 2
  282. ENDIF
  283. ENDIF
  284. END DO
  285. END DO
  286. ! Lagrange coefficients
  287. DO jfl = 1, jpnfl
  288. DO jind1 = 1, 4
  289. zlagxv(jfl,jind1) = 1.
  290. zlagyv(jfl,jind1) = 1.
  291. zlagzv(jfl,jind1) = 1.
  292. END DO
  293. END DO
  294. DO jind1 = 1, 4
  295. DO jind2 = 1, 4
  296. DO jfl = 1, jpnfl
  297. IF( jind1 /= jind2 ) THEN
  298. zlagxv(jfl,jind1)= zlagxv(jfl,jind1)*(pxt(jfl) - (float(iidv(jfl,jind2)) ) )
  299. zlagyv(jfl,jind1)= zlagyv(jfl,jind1)*(pyt(jfl) - (float(ijdv(jfl,jind2))+.5) )
  300. zlagzv(jfl,jind1)= zlagzv(jfl,jind1)*(pzt(jfl) - (float(ikdv(jfl,jind2)) ) )
  301. ENDIF
  302. END DO
  303. END DO
  304. END DO
  305. ! velocity when we compute at middle time step
  306. DO jfl = 1, jpnfl
  307. DO jind1 = 1, 4
  308. DO jind2 = 1, 4
  309. DO jind3 = 1 ,4
  310. ztvfl(jfl,jind1,jind2,jind3)= &
  311. & ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) + &
  312. & tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) ) &
  313. & / e2v(iidv(jfl,jind1),ijdv(jfl,jind2))
  314. END DO
  315. END DO
  316. END DO
  317. zsumv=0.
  318. DO jind1 = 1, 4
  319. DO jind2 = 1, 4
  320. DO jind3 = 1, 4
  321. zsumv = zsumv + ztvfl(jfl,jind1,jind2,jind3) * zlagxv(jfl,jind1) * zlagyv(jfl,jind2) &
  322. & * zlagzv(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
  323. END DO
  324. END DO
  325. END DO
  326. pvfl(jfl) = zsumv
  327. END DO
  328. ! Interpolation of W velocity
  329. ! nearest neightboring point for computation of w
  330. DO jfl = 1, jpnfl
  331. iilw(jfl) = INT( pxt(jfl) )
  332. ijlw(jfl) = INT( pyt(jfl) )
  333. iklw(jfl) = INT( pzt(jfl)+.5)
  334. END DO
  335. ! 64 neightboring points for computation of w
  336. DO jind1 = 1, 4
  337. DO jfl = 1, jpnfl
  338. ! i-direction
  339. IF( iilw(jfl) <= 2 ) THEN ; iidw(jfl,jind1) = jind1
  340. ELSE
  341. IF( iilw(jfl) >= jpi-1 ) THEN ; iidw(jfl,jind1) = jpi + jind1 - 4
  342. ELSE ; iidw(jfl,jind1) = iilw(jfl) + jind1 - 2
  343. ENDIF
  344. ENDIF
  345. ! j-direction
  346. IF( ijlw(jfl) <= 2 ) THEN ; ijdw(jfl,jind1) = jind1
  347. ELSE
  348. IF( ijlw(jfl) >= jpj-1 ) THEN ; ijdw(jfl,jind1) = jpj + jind1 - 4
  349. ELSE ; ijdw(jfl,jind1) = ijlw(jfl) + jind1 - 2
  350. ENDIF
  351. ENDIF
  352. ! k-direction
  353. IF( iklw(jfl) <= 2 ) THEN ; ikdw(jfl,jind1) = jind1
  354. ELSE
  355. IF( iklw(jfl) >= jpk-1 ) THEN ; ikdw(jfl,jind1) = jpk + jind1 - 4
  356. ELSE ; ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
  357. ENDIF
  358. ENDIF
  359. END DO
  360. END DO
  361. DO jind1 = 1, 4
  362. DO jfl = 1, jpnfl
  363. IF( iklw(jfl) <= 2 ) THEN ; ikdw(jfl,jind1) = jind1
  364. ELSE
  365. IF( iklw(jfl) >= jpk-1 ) THEN ; ikdw(jfl,jind1) = jpk + jind1 - 4
  366. ELSE ; ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
  367. ENDIF
  368. ENDIF
  369. END DO
  370. END DO
  371. ! Lagrange coefficients for w interpolation
  372. DO jfl = 1, jpnfl
  373. DO jind1 = 1, 4
  374. zlagxw(jfl,jind1) = 1.
  375. zlagyw(jfl,jind1) = 1.
  376. zlagzw(jfl,jind1) = 1.
  377. END DO
  378. END DO
  379. DO jind1 = 1, 4
  380. DO jind2 = 1, 4
  381. DO jfl = 1, jpnfl
  382. IF( jind1 /= jind2 ) THEN
  383. zlagxw(jfl,jind1) = zlagxw(jfl,jind1) * (pxt(jfl) - (float(iidw(jfl,jind2)) ) )
  384. zlagyw(jfl,jind1) = zlagyw(jfl,jind1) * (pyt(jfl) - (float(ijdw(jfl,jind2)) ) )
  385. zlagzw(jfl,jind1) = zlagzw(jfl,jind1) * (pzt(jfl) - (float(ikdw(jfl,jind2))-.5) )
  386. ENDIF
  387. END DO
  388. END DO
  389. END DO
  390. ! velocity w when we compute at middle time step
  391. DO jfl = 1, jpnfl
  392. DO jind1 = 1, 4
  393. DO jind2 = 1, 4
  394. DO jind3 = 1, 4
  395. ztwfl(jfl,jind1,jind2,jind3)= &
  396. & ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+ &
  397. & tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) ) &
  398. & / fse3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
  399. END DO
  400. END DO
  401. END DO
  402. zsumw = 0.e0
  403. DO jind1 = 1, 4
  404. DO jind2 = 1, 4
  405. DO jind3 = 1, 4
  406. zsumw = zsumw + ztwfl(jfl,jind1,jind2,jind3) * zlagxw(jfl,jind1) * zlagyw(jfl,jind2) &
  407. & * zlagzw(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
  408. END DO
  409. END DO
  410. END DO
  411. pwfl(jfl) = zsumw
  412. END DO
  413. !
  414. CALL wrk_dealloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )
  415. CALL wrk_dealloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )
  416. CALL wrk_dealloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )
  417. CALL wrk_dealloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )
  418. !
  419. END SUBROUTINE flo_interp
  420. # else
  421. !!----------------------------------------------------------------------
  422. !! No floats Dummy module
  423. !!----------------------------------------------------------------------
  424. #endif
  425. !!======================================================================
  426. END MODULE flo4rk