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/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 9 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

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