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 NEMO/trunk/src/OCE/FLO – NEMO

source: NEMO/trunk/src/OCE/FLO/flowri.F90

Last change on this file was 15062, checked in by jchanut, 3 years ago

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