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.
flowri.F90 in branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

source: branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 @ 2844

Last change on this file since 2844 was 2844, checked in by cbricaud, 13 years ago

minor corrections
  • Property svn:keywords set to Id
File size: 12.8 KB
Line 
1MODULE flowri
2   !!======================================================================
3   !!                       ***  MODULE  flowri  ***
4   !! blablabla: floteur....
5   !!======================================================================
6   !!  History :
7   !!    8.0  !  99-09  (Y. Drillet)    : Original code
8   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS
9   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
10   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others
11   !!----------------------------------------------------------------------
12#if   defined key_floats   ||   defined key_esopa
13   !!----------------------------------------------------------------------
14   !!   'key_floats'                                     float trajectories
15   !!----------------------------------------------------------------------
16
17   !! * Modules used
18   USE flo_oce         ! ocean drifting floats
19   USE oce             ! ocean dynamics and tracers
20   USE dom_oce         ! ocean space and time domain
21   USE lib_mpp         ! distribued memory computing library
22   USE in_out_manager  ! I/O manager
23   USE phycst          ! physic constants
24   USE dianam          ! build name of file (routine)
25   USE ioipsl
26   USE iom             ! I/O library
27
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC flo_wri      ! routine called by floats.F90
33   PUBLIC flo_wri_alloc   ! routine called by floats.F90
34
35   INTEGER :: jfl      ! number of floats
36   CHARACTER (len=80)  :: clname             ! netcdf output filename
37
38   ! Following are only workspace arrays but shape is not (jpi,jpj) and
39   ! therefore make them module arrays rather than replacing with wrk_nemo
40   ! member arrays.
41   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zlon , zlat, zdep   ! 2D workspace
42   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztem, zsal, zrho   ! 2D workspace
43
44   !! * Substitutions
45#  include "domzgr_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
48   !! $Header:
49   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
50   !!----------------------------------------------------------------------
51
52CONTAINS
53
54   INTEGER FUNCTION flo_wri_alloc()
55      !!-------------------------------------------------------------------
56      !!                ***  FUNCTION flo_wri_alloc  ***
57      !!-------------------------------------------------------------------
58      ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , &
59                zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc)
60      ! 
61      IF( lk_mpp             )   CALL mpp_sum ( flo_wri_alloc )
62      IF( flo_wri_alloc /= 0 )   CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.')
63   END FUNCTION flo_wri_alloc
64
65   SUBROUTINE flo_wri( kt )
66      !!---------------------------------------------------------------------
67      !!                  ***  ROUTINE flo_wri ***
68      !!             
69      !! ** Purpose :   Write position of floats in "trajec_float.nc",according
70      !!                to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ )  n
71      !!                nomenclature
72      !!   
73      !!     
74      !! ** Method  :   The frequency of  ??? is nwritefl
75      !!     
76      !!----------------------------------------------------------------------
77      !! * Arguments
78      INTEGER  :: kt                               ! time step
79
80      !! * Local declarations
81      INTEGER  :: iafl , ibfl , icfl             ! temporary integer
82      INTEGER  :: ia1fl, ib1fl, ic1fl            !   "
83      INTEGER  :: iafloc,ibfloc,ia1floc,ib1floc  !   "
84      INTEGER  :: irec, irecflo
85
86      REAL(wp) :: zafl,zbfl,zcfl                 ! temporary real
87      REAL(wp) :: ztime                          !   "
88      !REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 !   "
89
90      INTEGER, DIMENSION(2)          :: icount
91      INTEGER, DIMENSION(2)          :: istart
92
93      INTEGER, DIMENSION(1) ::   ish
94      INTEGER, DIMENSION(2) ::   ish2
95      REAL(wp), DIMENSION(jpnfl*jpk) ::   zwork   ! 1D workspace
96      !!----------------------------------------------------------------------
97     
98      !-----------------------------------------------------
99      ! I- Save positions, temperature, salinty and density
100      !-----------------------------------------------------
101      zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 
102      ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 
103
104      DO jfl = 1, jpnfl
105
106         iafl  = INT (tpifl(jfl))            ! I-index of the nearest point before
107         ibfl  = INT (tpjfl(jfl))            ! J-index of the nearest point before
108         icfl  = INT (tpkfl(jfl))            ! K-index of the nearest point before
109         ia1fl = iafl + 1                    ! I-index of the nearest point after
110         ib1fl = ibfl + 1                    ! J-index of the nearest point after
111         ic1fl = icfl + 1                    ! K-index of the nearest point after
112         zafl  = tpifl(jfl) - REAL(iafl,wp)  ! distance  ?????
113         zbfl  = tpjfl(jfl) - REAL(ibfl,wp)  ! distance  ?????
114         zcfl  = tpkfl(jfl) - REAL(icfl,wp)  ! distance  ?????
115
116         IF( lk_mpp ) THEN
117               
118            iafloc = mi1( iafl )
119            ibfloc = mj1( ibfl )
120 
121            IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
122              & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN 
123
124               !the float is inside of current proc's area
125               ia1floc = iafloc + 1
126               ib1floc = ibfloc + 1
127     
128               !save position of the float
129               zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
130                     +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)   
131               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
132                     +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
133               zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)     
134
135               !save temperature, salinity and density at this position
136               ztem(jfl) = tn(iafloc,ibfloc,icfl)
137               zsal (jfl) = sn(iafloc,ibfloc,icfl)
138               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
139           
140            ELSE ! the float is not inside of current proc's area
141
142               zlon(jfl) = 0.
143               zlat(jfl) = 0.
144               zdep(jfl) = 0.
145               ztem(jfl) = 0.
146               zsal (jfl) = 0.
147               zrho (jfl) = 0.
148
149            ENDIF
150
151         ELSE  ! mono proc case 
152
153            iafloc  = iafl
154            ibfloc  = ibfl
155            ia1floc = iafloc + 1
156            ib1floc = ibfloc + 1
157
158            !save position of the float               
159            zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
160                      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)
161            zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
162                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
163            zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)
164
165            ztem(jfl) = tn(iafloc,ibfloc,icfl)
166            zsal(jfl) = sn(iafloc,ibfloc,icfl)
167            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
168         
169         ENDIF
170
171      END DO ! loop on float
172
173      !Only proc 0 writes all positions : SUM of positions on all procs
174      IF( lk_mpp ) THEN
175         CALL mpp_sum( zlon, jpnfl )   ! sums over the global domain
176         CALL mpp_sum( zlat, jpnfl )   ! sums over the global domain
177         CALL mpp_sum( zdep, jpnfl )   ! sums over the global domain
178         CALL mpp_sum( ztem, jpnfl )   ! sums over the global domain
179         CALL mpp_sum( zsal, jpnfl )   ! sums over the global domain
180         CALL mpp_sum( zrho, jpnfl )   ! sums over the global domain
181      ENDIF
182
183
184      !-------------------------------------!
185      ! II- WRITE WRITE WRITE WRITE WRITE   !
186      !-------------------------------------!
187
188      !--------------------------!
189      ! II-1 Write in ascii file !
190      !--------------------------!
191
192      IF( ln_flo_ascii )THEN
193
194         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
195
196            !II-2-a Open ascii file
197            !----------------------
198            IF( kt == nn_it000 ) THEN
199               CALL ctl_opn( numfl, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
200               irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
201               WRITE(numfl,*)cexper,no,irecflo,jpnfl,nn_writefl
202            ENDIF
203
204            !III-2-b Write in ascii file
205            !-----------------------------
206            WRITE(numfl,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
207
208
209            !III-2-c Close netcdf file
210            !-------------------------
211            IF( kt == nitend )   CLOSE( numfl )
212
213         ENDIF
214
215      !-----------------------------------------------------
216      ! III- Write in netcdf file
217      !-----------------------------------------------------
218
219      ELSE
220
221#if defined key_iomput
222         CALL iom_put( "traj_lon"     , zlon )
223         CALL iom_put( "traj_lat"     , zlat )
224         CALL iom_put( "traj_dep"     , zdep )
225         CALL iom_put( "traj_temp"    , ztem )
226         CALL iom_put( "traj_salt"    , zsal  )
227         CALL iom_put( "traj_dens"    , zrho )
228         CALL iom_put( "traj_group"   , REAL(ngrpfl,wp) )
229#else
230
231      !III-2 Write with IOIPSL
232      !----------------------
233
234         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
235
236
237            !III-2-a Open netcdf file
238            !-----------------------
239            IF( kt==nn_it000 )THEN   ! Create and open
240
241               CALL dia_nam( clname, nn_writefl, 'trajec_float' )
242               clname=TRIM(clname)//".nc"
243
244               CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numfl )
245   
246               CALL fliodefv( numfl, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  )
247               CALL fliodefv( numfl, 'traj_lat'    , (/1,2/), v_t=flio_r8, long_name="Latitude"            , units="degrees_north" )
248               CALL fliodefv( numfl, 'traj_depth'  , (/1,2/), v_t=flio_r8, long_name="Depth"               , units="meters" )
249               CALL fliodefv( numfl, 'time_counter', (/2/)  , v_t=flio_r8, long_name="Time axis"           & 
250                         & , units="seconds since start of the run " )
251               CALL fliodefv( numfl, 'traj_temp'   , (/1,2/), v_t=flio_r8, long_name="Temperature"         , units="C" )
252               CALL fliodefv( numfl, 'traj_salt'   , (/1,2/), v_t=flio_r8, long_name="Salinity"            , units="PSU" )
253               CALL fliodefv( numfl, 'traj_dens'   , (/1,2/), v_t=flio_r8, long_name="Density"             , units="kg/m3" )
254               CALL fliodefv( numfl, 'traj_group'  , (/1/)  , v_t=flio_r8, long_name="number of the group" , units="no unit" )
255
256               CALL flioputv( numfl , 'traj_group' , REAL(ngrpfl,wp) )
257 
258            ELSE  ! Re-open
259       
260               CALL flioopfd( TRIM(clname), numfl , "WRITE" )
261
262            ENDIF
263
264            !III-2-b Write in  netcdf file
265            !-----------------------------
266            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1
267            ztime = ( kt-nn_it000 + 1 ) * rdt
268
269            CALL flioputv( numfl , 'time_counter', ztime , start=(/irec/) )
270
271            DO jfl = 1, jpnfl
272
273               istart = (/jfl,irec/)
274               icfl   = INT( tpkfl(jfl) )            ! K-index of the nearest point before
275
276               CALL flioputv( numfl , 'traj_lon'    , zlon(jfl)        , start=istart )
277               CALL flioputv( numfl , 'traj_lat'    , zlat(jfl)        , start=istart ) 
278               CALL flioputv( numfl , 'traj_depth'  , zdep(jfl)        , start=istart ) 
279               CALL flioputv( numfl , 'traj_temp'   , ztemp(icfl,jfl)  , start=istart ) 
280               CALL flioputv( numfl , 'traj_salt'   , zsal(icfl,jfl)   , start=istart ) 
281               CALL flioputv( numfl , 'traj_dens'   , zrho(icfl,jfl)   , start=istart ) 
282
283            ENDDO
284
285            !III-2-c Close netcdf file
286            !-------------------------
287            CALL flioclo( numfl )
288
289         ENDIF
290
291#endif
292      ENDIF ! netcdf writing
293   
294   END SUBROUTINE flo_wri
295
296
297#  else
298   !!----------------------------------------------------------------------
299   !!   Default option                                         Empty module
300   !!----------------------------------------------------------------------
301CONTAINS
302   SUBROUTINE flo_wri                 ! Empty routine
303   END SUBROUTINE flo_wri
304#endif
305
306   !!=======================================================================
307END MODULE flowri
Note: See TracBrowser for help on using the repository browser.