New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
floblk.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 12 years ago

Merge of 3.4beta into the trunk

  • Property svn:keywords set to Id
File size: 19.5 KB
RevLine 
[3]1MODULE floblk
2   !!======================================================================
3   !!                     ***  MODULE  floblk  ***
4   !! Ocean floats :   trajectory computation
5   !!======================================================================
6#if   defined key_floats   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_floats'                                     float trajectories
9   !!----------------------------------------------------------------------
10   !!    flotblk     : compute float trajectories with Blanke algorithme
11   !!----------------------------------------------------------------------
12   USE flo_oce         ! ocean drifting floats
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
[2715]16   USE obc_par         ! open boundary condition parameters
[16]17   USE in_out_manager  ! I/O manager
[3]18   USE lib_mpp         ! distribued memory computing library
[3294]19   USE wrk_nemo        ! working array
[3]20
21   IMPLICIT NONE
22   PRIVATE
23
[2528]24   PUBLIC   flo_blk    ! routine called by floats.F90
[623]25
26   !! * Substitutions
27#  include "domzgr_substitute.h90"
[3]28   !!----------------------------------------------------------------------
[2528]29   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]30   !! $Id$
[2528]31   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE flo_blk( kt )
36      !!---------------------------------------------------------------------
37      !!                  ***  ROUTINE flo_blk  ***
38      !!           
39      !! ** Purpose :   Compute the geographical position,latitude, longitude
40      !!      and depth of each float at each time step.
41      !!
42      !! ** Method  :   The position of a float is computed with Bruno Blanke
43      !!      algorithm. We need to know the velocity field, the old positions
44      !!      of the floats and the grid defined on the domain.
45      !!----------------------------------------------------------------------
46      INTEGER, INTENT( in  ) ::   kt ! ocean time step
[2528]47      !!
[3]48      INTEGER :: jfl              ! dummy loop arguments
49      INTEGER :: ind, ifin, iloop
50      REAL(wp)   ::       &
51         zuinfl,zvinfl,zwinfl,      &     ! transport across the input face
52         zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face
53         zvol,                      &     ! volume of the mesh
54         zsurfz,                    &     ! surface of the face of the mesh
55         zind
[3294]56
[2528]57      REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh
[3294]58
59      INTEGER  , POINTER, DIMENSION ( : )  ::   iil, ijl, ikl                   ! index of nearest mesh
60      INTEGER  , POINTER, DIMENSION ( : )  ::   iiloc , ijloc             
61      INTEGER  , POINTER, DIMENSION ( : )  ::   iiinfl, ijinfl, ikinfl          ! index of input mesh of the float.
62      INTEGER  , POINTER, DIMENSION ( : )  ::   iioutfl, ijoutfl, ikoutfl       ! index of output mesh of the float.
63      REAL(wp) , POINTER, DIMENSION ( : )  ::   zgifl, zgjfl, zgkfl             ! position of floats, index on
64      !                                                                         ! velocity mesh.
65      REAL(wp) , POINTER, DIMENSION ( : )  ::    ztxfl, ztyfl, ztzfl            ! time for a float to quit the mesh
66      !                                                                         ! across one of the face x,y and z
67      REAL(wp) , POINTER, DIMENSION ( : )  ::    zttfl                          ! time for a float to quit the mesh
68      REAL(wp) , POINTER, DIMENSION ( : )  ::    zagefl                         ! time during which, trajectorie of
69      !                                                                         ! the float has been computed
70      REAL(wp) , POINTER, DIMENSION ( : )  ::   zagenewfl                       ! new age of float after calculation
71      !                                                                         ! of new position
72      REAL(wp) , POINTER, DIMENSION ( : )  ::   zufl, zvfl, zwfl                ! interpolated vel. at float position
73      REAL(wp) , POINTER, DIMENSION ( : )  ::   zudfl, zvdfl, zwdfl             ! velocity diff input/output of mesh
74      REAL(wp) , POINTER, DIMENSION ( : )  ::   zgidfl, zgjdfl, zgkdfl          ! direction index of float
[3]75      !!---------------------------------------------------------------------
[3294]76      CALL wrk_alloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           )
77      CALL wrk_alloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )
78      CALL wrk_alloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl) 
79      CALL wrk_alloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   )
80
[3]81      IF( kt == nit000 ) THEN
82         IF(lwp) WRITE(numout,*)
83         IF(lwp) WRITE(numout,*) 'flo_blk : compute Blanke trajectories for floats '
84         IF(lwp) WRITE(numout,*) '~~~~~~~ '
85      ENDIF
86
87      ! Initialisation of parameters
88     
89      DO jfl = 1, jpnfl
90         ! ages of floats are put at zero
91         zagefl(jfl) = 0.
92         ! index on the velocity grid
93         ! We considere k coordinate negative, with this transformation
94         ! the computation in the 3 direction is the same.
95         zgifl(jfl) = tpifl(jfl) - 0.5
96         zgjfl(jfl) = tpjfl(jfl) - 0.5
97         zgkfl(jfl) = MIN(-1.,-(tpkfl(jfl)))
98         ! surface drift every 10 days
99         IF( ln_argo ) THEN
100            IF( MOD(kt,150) >= 146 .OR. MOD(kt,150) == 0 )  zgkfl(jfl) = -1.
101         ENDIF
102         ! index of T mesh
103         iil(jfl) = 1 + INT(zgifl(jfl))
104         ijl(jfl) = 1 + INT(zgjfl(jfl))
105         ikl(jfl) =     INT(zgkfl(jfl))
106      END DO
107       
108      iloop = 0
109222   DO jfl = 1, jpnfl
[2528]110# if   defined key_mpp_mpi
[3]111         IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   &
112             (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN
113            iiloc(jfl) = iil(jfl) - (mig(1)-jpizoom+1) + 1
114            ijloc(jfl) = ijl(jfl) - (mjg(1)-jpjzoom+1) + 1
115# else
116            iiloc(jfl) = iil(jfl)
117            ijloc(jfl) = ijl(jfl)
118# endif
119           
120            ! compute the transport across the mesh where the float is.           
[466]121!!bug (gm) change e3t into fse3. but never checked
122            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * fse3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
123            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * fse3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
124            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * fse3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
125            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * fse3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
[3]126
127            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
[466]128            zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl))
[623]129            zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl))
[3]130
131            !
132            zuinfl =( ub(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(1)
133            zuoutfl=( ub(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(2)
134            zvinfl =( vb(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) )/2.*zsurfy(1)
135            zvoutfl=( vb(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) )/2.*zsurfy(2)
136            zwinfl =-(wb(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1))    &
137               &   +  wn(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl)
138            zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl)   )   &
139               &   +  wn(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl)
140           
141            ! interpolation of velocity field on the float initial position           
142            zufl(jfl)=  zuinfl  + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl)
143            zvfl(jfl)=  zvinfl  + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl)
144            zwfl(jfl)=  zwinfl  + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl)
145           
146            ! faces of input and output
147            ! u-direction
148            IF( zufl(jfl) < 0. ) THEN
149               iioutfl(jfl) = iil(jfl) - 1.
150               iiinfl (jfl) = iil(jfl)
151               zind   = zuinfl
152               zuinfl = zuoutfl
153               zuoutfl= zind
154            ELSE
155               iioutfl(jfl) = iil(jfl)
156               iiinfl (jfl) = iil(jfl) - 1
157            ENDIF
158            ! v-direction       
159            IF( zvfl(jfl) < 0. ) THEN
160               ijoutfl(jfl) = ijl(jfl) - 1.
161               ijinfl (jfl) = ijl(jfl)
162               zind    = zvinfl
163               zvinfl  = zvoutfl
164               zvoutfl = zind
165            ELSE
166               ijoutfl(jfl) = ijl(jfl)
167               ijinfl (jfl) = ijl(jfl) - 1.
168            ENDIF
169            ! w-direction
170            IF( zwfl(jfl) < 0. ) THEN
171               ikoutfl(jfl) = ikl(jfl) - 1.
172               ikinfl (jfl) = ikl(jfl)
173               zind    = zwinfl
174               zwinfl  = zwoutfl
175               zwoutfl = zind
176            ELSE
177               ikoutfl(jfl) = ikl(jfl)
178               ikinfl (jfl) = ikl(jfl) - 1.
179            ENDIF
180           
181            ! compute the time to go out the mesh across a face
182            ! u-direction
183            zudfl (jfl) = zuoutfl - zuinfl
184            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl))
185            IF( zufl(jfl)*zuoutfl <= 0. ) THEN
186               ztxfl(jfl) = 1.E99
187            ELSE
188               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN
189                  ztxfl(jfl)= zgidfl(jfl)/zudfl(jfl) * LOG(zuoutfl/zufl (jfl))
190               ELSE
191                  ztxfl(jfl)=(float(iioutfl(jfl))-zgifl(jfl))/zufl(jfl)
192               ENDIF
193               IF( (ABS(zgifl(jfl)-float(iiinfl (jfl))) <=  1.E-7) .OR.   &
194                   (ABS(zgifl(jfl)-float(iioutfl(jfl))) <=  1.E-7) ) THEN
195                  ztxfl(jfl)=(zgidfl(jfl))/zufl(jfl)
196               ENDIF
197            ENDIF
198            ! v-direction
199            zvdfl (jfl) = zvoutfl - zvinfl
200            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl))
201            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN
202               ztyfl(jfl) = 1.E99
203            ELSE
204               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN
205                  ztyfl(jfl) = zgjdfl(jfl)/zvdfl(jfl) * LOG(zvoutfl/zvfl (jfl))
206               ELSE
207                  ztyfl(jfl) = (float(ijoutfl(jfl)) - zgjfl(jfl))/zvfl(jfl)
208               ENDIF
209               IF( (ABS(zgjfl(jfl)-float(ijinfl (jfl))) <= 1.E-7) .OR.   &
210                   (ABS(zgjfl(jfl)-float(ijoutfl(jfl))) <=  1.E-7) ) THEN
211                  ztyfl(jfl) = (zgjdfl(jfl)) / zvfl(jfl)
212               ENDIF
213            ENDIF
214            ! w-direction       
215            IF( nisobfl(jfl) == 1. ) THEN
216               zwdfl (jfl) = zwoutfl - zwinfl
217               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl))
218               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN
219                  ztzfl(jfl) = 1.E99
220               ELSE
221                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN
222                     ztzfl(jfl) = zgkdfl(jfl)/zwdfl(jfl) * LOG(zwoutfl/zwfl (jfl))
223                  ELSE
224                     ztzfl(jfl) = (float(ikoutfl(jfl)) - zgkfl(jfl))/zwfl(jfl)
225                  ENDIF
226                  IF( (ABS(zgkfl(jfl)-float(ikinfl (jfl))) <=  1.E-7) .OR.   &
227                      (ABS(zgkfl(jfl)-float(ikoutfl(jfl))) <= 1.E-7) ) THEN
228                     ztzfl(jfl) = (zgkdfl(jfl)) / zwfl(jfl)
229                  ENDIF
230               ENDIF
231            ENDIF
232           
233            ! the time to go leave the mesh is the smallest time
234                   
235            IF( nisobfl(jfl) == 1. ) THEN
236               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl))
237            ELSE
238               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl))
239            ENDIF
240            ! new age of the FLOAT
241            zagenewfl(jfl) = zagefl(jfl) + zttfl(jfl)*zvol
242            ! test to know if the "age" of the float is not bigger than the
243            ! time step
244            IF( zagenewfl(jfl) > rdt ) THEN
245               zttfl(jfl) = (rdt-zagefl(jfl)) / zvol
246               zagenewfl(jfl) = rdt
247            ENDIF
248           
249            ! In the "minimal" direction we compute the index of new mesh
250            ! on i-direction
251            IF( ztxfl(jfl) <=  zttfl(jfl) ) THEN
252               zgifl(jfl) = float(iioutfl(jfl))
253               ind = iioutfl(jfl)
254               IF( iioutfl(jfl) >= iiinfl(jfl) ) THEN
255                  iioutfl(jfl) = iioutfl(jfl) + 1
256               ELSE
257                  iioutfl(jfl) = iioutfl(jfl) - 1
258               ENDIF
259               iiinfl(jfl) = ind
260            ELSE
261               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN
262                  zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl)    &
263                     &       * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) /  zudfl(jfl)
264               ELSE
265                  zgifl(jfl) = zgifl(jfl) + zufl(jfl) * zttfl(jfl)
266               ENDIF
267            ENDIF
268            ! on j-direction
269            IF( ztyfl(jfl) <= zttfl(jfl) ) THEN
270               zgjfl(jfl) = float(ijoutfl(jfl))
271               ind = ijoutfl(jfl)
272               IF( ijoutfl(jfl) >= ijinfl(jfl) ) THEN
273                  ijoutfl(jfl) = ijoutfl(jfl) + 1
274               ELSE
275                  ijoutfl(jfl) = ijoutfl(jfl) - 1
276               ENDIF
277               ijinfl(jfl) = ind
278            ELSE
279               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN
280                  zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl)   &
281                     &       * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) /  zvdfl(jfl)
282               ELSE
283                  zgjfl(jfl) = zgjfl(jfl)+zvfl(jfl)*zttfl(jfl)
284               ENDIF
285            ENDIF
286            ! on k-direction
287            IF( nisobfl(jfl) == 1. ) THEN
288               IF( ztzfl(jfl) <= zttfl(jfl) ) THEN
289                  zgkfl(jfl) = float(ikoutfl(jfl))
290                  ind = ikoutfl(jfl)
291                  IF( ikoutfl(jfl) >= ikinfl(jfl) ) THEN
292                     ikoutfl(jfl) = ikoutfl(jfl)+1
293                  ELSE
294                     ikoutfl(jfl) = ikoutfl(jfl)-1
295                  ENDIF
296                  ikinfl(jfl) = ind
297               ELSE
298                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN
299                     zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl)    &
300                        &       * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) /  zwdfl(jfl)
301                  ELSE
302                     zgkfl(jfl) = zgkfl(jfl)+zwfl(jfl)*zttfl(jfl)
303                  ENDIF
304               ENDIF
305            ENDIF
306           
307            ! coordinate of the new point on the temperature grid
308           
309            iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl))
310            ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl))
311            IF( nisobfl(jfl) ==  1 ) ikl(jfl) = MAX(ikinfl(jfl),ikoutfl(jfl))
312!!Alexcadm   write(*,*)'PE ',narea,
313!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
314!!Alexcadm     .     ,ijoutfl(jfl),ikinfl(jfl),
315!!Alexcadm     .    ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
316!!Alexcadm     .     ,ztzfl(jfl),zgifl(jfl),
317!!Alexcadm     .  zgjfl(jfl)
318!!Alexcadm  IF (jfl == 910) write(*,*)'Flotteur 910',
319!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
320!!Alexcadm     .     ,ijoutfl(jfl),ikinfl(jfl),
321!!Alexcadm     .    ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
322!!Alexcadm     .     ,ztzfl(jfl),zgifl(jfl),
323!!Alexcadm     .  zgjfl(jfl)
324            ! reinitialisation of the age of FLOAT
325            zagefl(jfl) = zagenewfl(jfl)
[2528]326# if   defined key_mpp_mpi
[3]327         ELSE
328            ! we put zgifl, zgjfl, zgkfl, zagefl
329            zgifl (jfl) = 0.
330            zgjfl (jfl) = 0.
331            zgkfl (jfl) = 0.
332            zagefl(jfl) = 0.
333            iil(jfl) = 0
334            ijl(jfl) = 0
335         ENDIF
336# endif
337      END DO
338     
339      ! synchronisation
[16]340      IF( lk_mpp )   CALL mpp_sum( zgifl , jpnfl )   ! sums over the global domain
341      IF( lk_mpp )   CALL mpp_sum( zgjfl , jpnfl )
342      IF( lk_mpp )   CALL mpp_sum( zgkfl , jpnfl )
343      IF( lk_mpp )   CALL mpp_sum( zagefl, jpnfl )
344      IF( lk_mpp )   CALL mpp_sum( iil   , jpnfl )
345      IF( lk_mpp )   CALL mpp_sum( ijl   , jpnfl )
[3]346     
347      ! in the case of open boundaries we need to test if the floats don't
348      ! go out of the domain. If it goes out, the float is put at the
349      ! middle of the mesh in the domain but the trajectory isn't compute
350      ! more time.     
351# if defined key_obc
352      DO jfl = 1, jpnfl
[84]353         IF( lp_obc_east ) THEN
[3]354            IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN
355               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
356               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
357               zagefl(jfl) = rdt
358            END IF
359         END IF
[84]360         IF( lp_obc_west ) THEN
[3]361            IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN
362               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
363               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
364               zagefl(jfl) = rdt
365            END IF
366         END IF
[84]367         IF( lp_obc_north ) THEN
[3]368            IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN
369               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
370               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
371               zagefl(jfl) = rdt
372            END IF
373         END IF
[84]374         IF( lp_obc_south ) THEN
[3]375            IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN
376               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
377               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
378               zagefl(jfl) = rdt
379            END IF
380         END IF
381      END DO
382#endif
383
384      ! Test to know if a  float hasn't integrated enought time
385      IF( ln_argo ) THEN
386         ifin = 1
387         DO jfl = 1, jpnfl
388            IF( zagefl(jfl) < rdt )   ifin = 0
389            tpifl(jfl) = zgifl(jfl) + 0.5
390            tpjfl(jfl) = zgjfl(jfl) + 0.5
391         END DO
392      ELSE
393         ifin = 1
394         DO jfl = 1, jpnfl
395            IF( zagefl(jfl) < rdt )   ifin = 0
396            tpifl(jfl) = zgifl(jfl) + 0.5
397            tpjfl(jfl) = zgjfl(jfl) + 0.5
398            IF( nisobfl(jfl) == 1 ) tpkfl(jfl) = -(zgkfl(jfl))
399         END DO
400      ENDIF
401!!Alexcadm  IF (lwp) write(numout,*) '---------'
402!!Alexcadm  IF (lwp) write(numout,*) 'before Erika:',tpifl(880),tpjfl(880),
403!!Alexcadm     .       tpkfl(880),zufl(880),zvfl(880),zwfl(880)
404!!Alexcadm  IF (lwp) write(numout,*) 'first Erika:',tpifl(900),tpjfl(900),
405!!Alexcadm     .       tpkfl(900),zufl(900),zvfl(900),zwfl(900)
406!!Alexcadm  IF (lwp) write(numout,*) 'last Erika:',tpifl(jpnfl),tpjfl(jpnfl),
407!!Alexcadm     .       tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl)
408      IF( ifin == 0 ) THEN
409         iloop = iloop + 1 
410         GO TO 222
411      ENDIF
[2528]412      !
[3294]413      CALL wrk_dealloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           )
414      CALL wrk_dealloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )
415      CALL wrk_dealloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl) 
416      CALL wrk_dealloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   )
417      !
[3]418   END SUBROUTINE flo_blk
419
420#  else
421   !!----------------------------------------------------------------------
422   !!   Default option                                         Empty module
423   !!----------------------------------------------------------------------
424CONTAINS
425   SUBROUTINE flo_blk                  ! Empty routine
426   END SUBROUTINE flo_blk 
427#endif
428   
429   !!======================================================================
430END MODULE floblk 
Note: See TracBrowser for help on using the repository browser.