source: NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/FLO/flowri.F90 @ 12165

Last change on this file since 12165 was 12165, checked in by davestorkey, 10 months ago

2019/dev_ASINTER-01-05_merged: Update to r12072 of trunk.

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