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

Last change on this file since 2839 was 2839, checked in by cbricaud, 9 years ago

modified routine for netcdf output

  • Property svn:keywords set to Id
File size: 13.7 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      !IF( MOD( kt,nn_writefl)== 0 ) THEN
99
100
101         !-----------------------------------------------------
102         ! I- Save positions, temperature, salinty and density
103         !-----------------------------------------------------
104         zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 
105         ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 
106
107         DO jfl = 1, jpnfl
108
109            iafl  = INT (tpifl(jfl))            ! I-index of the nearest point before
110            ibfl  = INT (tpjfl(jfl))            ! J-index of the nearest point before
111            icfl  = INT (tpkfl(jfl))            ! K-index of the nearest point before
112            ia1fl = iafl + 1                    ! I-index of the nearest point after
113            ib1fl = ibfl + 1                    ! J-index of the nearest point after
114            ic1fl = icfl + 1                    ! K-index of the nearest point after
115            zafl  = tpifl(jfl) - REAL(iafl,wp)  ! distance  ?????
116            zbfl  = tpjfl(jfl) - REAL(ibfl,wp)  ! distance  ?????
117            zcfl  = tpkfl(jfl) - REAL(icfl,wp)  ! distance  ?????
118
119            write(narea+200,*)'A', jfl,iafl,ibfl
120
121            IF( lk_mpp ) THEN
122               
123               iafloc = mi1( iafl )
124               ibfloc = mj1( ibfl )
125 
126               IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
127                 & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN
128
129                  write(narea+200,*)'B',jfl,iafloc,ibfloc,glamt(iafloc ,ibfloc )
130                  write(narea+200,*)'B',zafl,zbfl
131
132                  !the float is inside of current proc's area
133                  ia1floc = iafloc + 1
134                  ib1floc = ibfloc + 1
135     
136                  !save position of the float
137                  zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
138                        +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)   
139                  zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
140                        +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
141                  zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)     
142
143                  !save temperature, salinity and density at this position
144                  ztem(jfl) = tn(iafloc,ibfloc,icfl)
145                  zsal (jfl) = sn(iafloc,ibfloc,icfl)
146                  zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
147           
148               ELSE ! the float is not inside of current proc's area
149                  !write(narea+200,*)"notinside current proc: jfl ",jfl
150
151                  zlon(jfl) = 0.
152                  zlat(jfl) = 0.
153                  zdep(jfl) = 0.
154
155                  !ztemp(1:jpk,jfl) = 0.
156                  !zsal (1:jpk,jfl) = 0.
157                  !zrho (1:jpk,jfl) = 0.
158                  ztem(jfl) = 0.
159                  zsal (jfl) = 0.
160                  zrho (jfl) = 0.
161
162               ENDIF
163
164            ELSE  ! mono proc case 
165
166               iafloc  = iafl
167               ibfloc  = ibfl
168               ia1floc = iafloc + 1
169               ib1floc = ibfloc + 1
170
171               !save position of the float               
172               zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
173                         +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)
174               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
175                         +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
176               zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)
177
178               ztem(jfl) = tn(iafloc,ibfloc,icfl)
179               zsal(jfl) = sn(iafloc,ibfloc,icfl)
180               zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
181         
182            ENDIF
183
184         END DO ! loop on float
185
186         IF( lk_mpp ) THEN
187
188            ! Only proc 0 writes all positions
189               
190            !SUM of positions on all procs
191            write(narea+200,*)"zlon avt mpp_sum ",zlon
192            CALL mpp_sum( zlon, jpnfl )   ! sums over the global domain
193            write(narea+200,*)"zlon apr mpp_sum ",zlon
194            CALL mpp_sum( zlat, jpnfl )   ! sums over the global domain
195            CALL mpp_sum( zdep, jpnfl )   ! sums over the global domain
196            CALL mpp_sum( ztem, jpnfl )   ! sums over the global domain
197            CALL mpp_sum( zsal, jpnfl )   ! sums over the global domain
198            CALL mpp_sum( zrho, jpnfl )   ! sums over the global domain
199             
200         ENDIF
201
202
203      !ENDIF  !end of saving variables
204
205
206      !---------------------------------!
207      ! WRITE WRITE WRITE WRITE WRITE   !
208      !---------------------------------!
209
210      !-----------------------------------------------------
211      ! II- Write in ascii file
212      !-----------------------------------------------------
213
214      IF( ln_flo_ascii )THEN
215
216         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
217
218            !II-2-a Open ascii file
219            !----------------------
220            IF( kt == nn_it000 ) THEN
221               CALL ctl_opn( numfl, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
222               irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
223               WRITE(numfl,*)cexper,no,irecflo,jpnfl,nn_writefl
224            ENDIF
225
226            !III-2-b Write in ascii file
227            !-----------------------------
228            WRITE(numfl,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
229
230
231            !III-2-c Close netcdf file
232            !-------------------------
233            IF( kt == nitend )   CLOSE( numfl )
234
235         ENDIF
236
237      !-----------------------------------------------------
238      ! III- Write in netcdf file
239      !-----------------------------------------------------
240
241      ELSE
242
243#if defined key_iomput
244         IF(lwp)WRITE(numout,*)"zlon ",zlon ; call FLUSH(numout)
245         CALL iom_put( "traj_lon"     , zlon )
246         CALL iom_put( "traj_lat"     , zlat )
247         CALL iom_put( "traj_dep"     , zdep )
248         CALL iom_put( "traj_temp"    , ztem )
249         CALL iom_put( "traj_salt"    , zsal  )
250         CALL iom_put( "traj_dens"    , zrho )
251         CALL iom_put( "traj_group"   , REAL(ngrpfl,wp) )
252#else
253
254      !III-2 Write with IOIPSL
255      !----------------------
256
257         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
258
259
260            !III-2-a Open netcdf file
261            !-----------------------
262            IF( kt==nn_it000 )THEN   ! Create and open
263
264               CALL dia_nam( clname, nn_writefl, 'trajec_float' )
265               clname=TRIM(clname)//".nc"
266
267               CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numfl )
268   
269               CALL fliodefv( numfl, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  )
270               CALL fliodefv( numfl, 'traj_lat'    , (/1,2/), v_t=flio_r8, long_name="Latitude"            , units="degrees_north" )
271               CALL fliodefv( numfl, 'traj_depth'  , (/1,2/), v_t=flio_r8, long_name="Depth"               , units="meters" )
272               CALL fliodefv( numfl, 'time_counter', (/2/)  , v_t=flio_r8, long_name="Time axis"           & 
273                         & , units="seconds since start of the run " )
274               CALL fliodefv( numfl, 'traj_temp'   , (/1,2/), v_t=flio_r8, long_name="Temperature"         , units="C" )
275               CALL fliodefv( numfl, 'traj_salt'   , (/1,2/), v_t=flio_r8, long_name="Salinity"            , units="PSU" )
276               CALL fliodefv( numfl, 'traj_dens'   , (/1,2/), v_t=flio_r8, long_name="Density"             , units="kg/m3" )
277               CALL fliodefv( numfl, 'traj_group'  , (/1/)  , v_t=flio_r8, long_name="number of the group" , units="no unit" )
278
279               CALL flioputv( numfl , 'traj_group' , REAL(ngrpfl,wp) )
280 
281            ELSE  ! Re-open
282       
283               CALL flioopfd( TRIM(clname), numfl , "WRITE" )
284
285            ENDIF
286
287            !III-2-b Write in  netcdf file
288            !-----------------------------
289            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1
290            ztime = ( kt-nn_it000 + 1 ) * rdt
291
292            CALL flioputv( numfl , 'time_counter', ztime , start=(/irec/) )
293
294            DO jfl = 1, jpnfl
295
296               istart = (/jfl,irec/)
297               icfl   = INT( tpkfl(jfl) )            ! K-index of the nearest point before
298
299               CALL flioputv( numfl , 'traj_lon'    , zlon(jfl)        , start=istart )
300               CALL flioputv( numfl , 'traj_lat'    , zlat(jfl)        , start=istart ) 
301               CALL flioputv( numfl , 'traj_depth'  , zdep(jfl)        , start=istart ) 
302               CALL flioputv( numfl , 'traj_temp'   , ztemp(icfl,jfl)  , start=istart ) 
303               CALL flioputv( numfl , 'traj_salt'   , zsal(icfl,jfl)   , start=istart ) 
304               CALL flioputv( numfl , 'traj_dens'   , zrho(icfl,jfl)   , start=istart ) 
305
306            ENDDO
307
308            !III-2-c Close netcdf file
309            !-------------------------
310            CALL flioclo( numfl )
311
312         ENDIF
313
314#endif
315      ENDIF ! netcdf writing
316   
317   END SUBROUTINE flo_wri
318
319
320#  else
321   !!----------------------------------------------------------------------
322   !!   Default option                                         Empty module
323   !!----------------------------------------------------------------------
324CONTAINS
325   SUBROUTINE flo_wri                 ! Empty routine
326   END SUBROUTINE flo_wri
327#endif
328
329   !!=======================================================================
330END MODULE flowri
Note: See TracBrowser for help on using the repository browser.