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

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

  • 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.