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 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

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