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/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

source: branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 @ 5777

Last change on this file since 5777 was 5777, checked in by gm, 8 years ago

#1593: LDF-ADV, III. Phasing of the improvements/simplifications of ADV & LDF momentum trends (see wiki page)

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