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