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.
diafwb.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 21.2 KB
Line 
1MODULE diafwb
2   !!======================================================================
3   !!                       ***  MODULE  diafwb  ***
4   !! Ocean diagnostics: freshwater budget
5   !!======================================================================
6   !! History :  8.2  !  01-02  (E. Durand)  Original code
7   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
8   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
9   !!----------------------------------------------------------------------
10   !!----------------------------------------------------------------------
11   !!   Only for ORCA2 ORCA1 and ORCA025
12   !!----------------------------------------------------------------------
13   !!----------------------------------------------------------------------
14   !!   dia_fwb     : freshwater budget for global ocean configurations
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers
17   USE dom_oce         ! ocean space and time domain
18   USE phycst          ! physical constants
19   USE sbc_oce         ! ???
20   USE zdf_oce         ! ocean vertical physics
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distributed memory computing library
23   USE timing          ! preformance summary
24
25   USE yomhook, ONLY: lhook, dr_hook
26   USE parkind1, ONLY: jprb, jpim
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC dia_fwb    ! routine called by step.F90
32
33   REAL(wp)               ::   a_fwf ,          &
34      &                        a_sshb, a_sshn, a_salb, a_saln
35   REAL(wp), DIMENSION(4) ::   a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
42   !! $Id$
43   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45
46CONTAINS
47
48   SUBROUTINE dia_fwb( kt )
49      !!---------------------------------------------------------------------
50      !!                  ***  ROUTINE dia_fwb  ***
51      !!     
52      !! ** Purpose :
53      !!----------------------------------------------------------------------
54      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
55      !!
56      INTEGER  :: inum             ! temporary logical unit
57      INTEGER  :: ji, jj, jk, jt   ! dummy loop indices
58      INTEGER  :: ii0, ii1, ij0, ij1
59      INTEGER  :: isrow         ! index for ORCA1 starting row
60      REAL(wp) :: zarea, zvol, zwei
61      REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
62      REAL(wp) :: zt, zs, zu 
63      REAL(wp) :: zsm0, zfwfnew
64      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
65      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
66      REAL(KIND=jprb)               :: zhook_handle
67
68      CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_FWB'
69
70      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
71
72      IF( cp_cfg == "orca" .AND. jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
73      !!----------------------------------------------------------------------
74      IF( nn_timing == 1 )   CALL timing_start('dia_fwb')
75
76      ! Mean global salinity
77      zsm0 = 34.72654
78
79      ! To compute fwf mean value mean fwf
80
81      IF( kt == nit000 ) THEN
82
83         a_fwf    = 0.e0
84         a_sshb   = 0.e0 ! valeur de ssh au debut de la simulation
85         a_salb   = 0.e0 ! valeur de sal au debut de la simulation
86         ! sshb used because diafwb called after tranxt (i.e. after the swap)
87         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
88         IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain
89
90         DO jk = 1, jpkm1
91            DO jj = 2, jpjm1
92               DO ji = fs_2, fs_jpim1   ! vector opt.
93                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
94                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei
95               END DO
96            END DO
97         END DO
98         IF( lk_mpp )   CALL mpp_sum( a_salb )      ! sum over the global domain
99      ENDIF
100     
101      a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
102      IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain
103
104      IF( kt == nitend ) THEN
105         a_sshn = 0.e0
106         a_saln = 0.e0
107         zarea = 0.e0
108         zvol  = 0.e0
109         zfwfnew = 0.e0
110         ! Mean sea level at nitend
111         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
112         IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain
113         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) )
114         IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain
115         
116         DO jk = 1, jpkm1   
117            DO jj = 2, jpjm1
118               DO ji = fs_2, fs_jpim1   ! vector opt.
119                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
120                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei
121                  zvol  = zvol  + zwei
122               END DO
123            END DO
124         END DO
125         IF( lk_mpp )   CALL mpp_sum( a_saln )      ! sum over the global domain
126         IF( lk_mpp )   CALL mpp_sum( zvol )      ! sum over the global domain
127         
128         ! Conversion in m3
129         a_fwf    = a_fwf * rdttra(1) * 1.e-3 
130         
131         ! fwf correction to bring back the mean ssh to zero
132         zfwfnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea
133
134      ENDIF
135
136
137      ! Calcul des termes de transport
138      ! ------------------------------
139     
140      ! 1 --> Gibraltar
141      ! 2 --> Cadiz
142      ! 3 --> Red Sea
143      ! 4 --> Baltic Sea
144
145      IF( kt == nit000 ) THEN
146         a_flxi(:) = 0.e0
147         a_flxo(:) = 0.e0
148         a_temi(:) = 0.e0
149         a_temo(:) = 0.e0
150         a_sali(:) = 0.e0
151         a_salo(:) = 0.e0
152      ENDIF
153
154      zflxi(:) = 0.e0
155      zflxo(:) = 0.e0
156      ztemi(:) = 0.e0
157      ztemo(:) = 0.e0
158      zsali(:) = 0.e0
159      zsalo(:) = 0.e0
160
161      ! Mean flow at Gibraltar
162
163      IF( cp_cfg == "orca" ) THEN 
164               
165         SELECT CASE ( jp_cfg )
166         !                                           ! =======================
167         CASE ( 4 )                                  !  ORCA_R4 configuration
168            !                                        ! =======================
169            ii0 = 70   ;   ii1 = 70
170            ij0 = 52   ;   ij1 = 52
171            !                                        ! =======================
172         CASE ( 2 )                                  !  ORCA_R2 configuration
173            !                                        ! =======================
174            ii0 = 140   ;   ii1 = 140
175            ij0 = 102   ;   ij1 = 102
176            !                                        ! =======================
177         CASE ( 1 )                                  !  ORCA_R1 configurations
178            !                                        ! =======================
179            ! This dirty section will be suppressed by simplification process:
180            ! all this will come back in input files
181            ! Currently these hard-wired indices relate to configuration with
182            ! extend grid (jpjglo=332)
183            isrow = 332 - jpjglo
184            !
185            ii0 = 283           ;   ii1 = 283
186            ij0 = 241 - isrow   ;   ij1 = 241 - isrow
187            !                                        ! =======================
188         CASE DEFAULT                                !    ORCA R05 or R025
189            !                                        ! =======================
190            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
191            !
192         END SELECT
193         !
194         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
195            DO jj = mj0(ij0), mj1(ij1)
196               DO jk = 1, jpk 
197                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
198                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
199                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
200
201                  IF( un(ji,jj,jk) > 0.e0 ) THEN
202                     zflxi(1) = zflxi(1) +    zu
203                     ztemi(1) = ztemi(1) + zt*zu
204                     zsali(1) = zsali(1) + zs*zu
205                  ELSE
206                     zflxo(1) = zflxo(1) +    zu
207                     ztemo(1) = ztemo(1) + zt*zu
208                     zsalo(1) = zsalo(1) + zs*zu
209                  ENDIF
210               END DO
211            END DO
212         END DO
213      ENDIF
214     
215      ! Mean flow at Cadiz
216      IF( cp_cfg == "orca" ) THEN
217               
218         SELECT CASE ( jp_cfg )
219         !                                           ! =======================
220         CASE ( 4 )                                  !  ORCA_R4 configuration
221            !                                        ! =======================
222            ii0 = 69   ;   ii1 = 69
223            ij0 = 52   ;   ij1 = 52
224            !                                        ! =======================
225         CASE ( 2 )                                  !  ORCA_R2 configuration
226            !                                        ! =======================
227            ii0 = 137   ;   ii1 = 137
228            ij0 = 101   ;   ij1 = 102
229            !                                        ! =======================
230         CASE ( 1 )                                  !  ORCA_R1 configurations
231            !                                        ! =======================
232            ! This dirty section will be suppressed by simplification process:
233            ! all this will come back in input files
234            ! Currently these hard-wired indices relate to configuration with
235            ! extend grid (jpjglo=332)
236            isrow = 332 - jpjglo
237            ii0 = 282           ;   ii1 = 282
238            ij0 = 240 - isrow   ;   ij1 = 240 - isrow
239            !                                        ! =======================
240         CASE DEFAULT                                !    ORCA R05 or R025
241            !                                        ! =======================
242            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
243            !
244         END SELECT
245         !
246         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
247            DO jj = mj0(ij0), mj1(ij1)
248               DO jk = 1, jpk 
249                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
250                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
251                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
252                 
253                  IF( un(ji,jj,jk) > 0.e0 ) THEN
254                     zflxi(2) = zflxi(2) +    zu
255                     ztemi(2) = ztemi(2) + zt*zu
256                     zsali(2) = zsali(2) + zs*zu
257                  ELSE
258                     zflxo(2) = zflxo(2) +    zu
259                     ztemo(2) = ztemo(2) + zt*zu
260                     zsalo(2) = zsalo(2) + zs*zu
261                  ENDIF
262               END DO
263            END DO
264         END DO
265      ENDIF
266
267      ! Mean flow at Red Sea entrance
268      IF( cp_cfg == "orca" ) THEN
269               
270         SELECT CASE ( jp_cfg )
271         !                                           ! =======================
272         CASE ( 4 )                                  !  ORCA_R4 configuration
273            !                                        ! =======================
274            ii0 = 83   ;   ii1 = 83
275            ij0 = 45   ;   ij1 = 45
276            !                                        ! =======================
277         CASE ( 2 )                                  !  ORCA_R2 configuration
278            !                                        ! =======================
279            ii0 = 160   ;   ii1 = 160
280            ij0 = 88    ;   ij1 = 88 
281            !                                        ! =======================
282         CASE ( 1 )                                  !  ORCA_R1 configurations
283            !                                        ! =======================
284            ! This dirty section will be suppressed by simplification process:
285            ! all this will come back in input files
286            ! Currently these hard-wired indices relate to configuration with
287            ! extend grid (jpjglo=332)
288            isrow = 332 - jpjglo
289            ii0 = 331           ;   ii1 = 331
290            ij0 = 215 - isrow   ;   ij1 = 215 - isrow
291            !                                        ! =======================
292         CASE DEFAULT                                !    ORCA R05 or R025
293            !                                        ! =======================
294            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
295            !
296         END SELECT
297         !
298         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
299            DO jj = mj0(ij0), mj1(ij1)
300               DO jk = 1, jpk 
301                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
302                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
303                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
304                 
305                  IF( un(ji,jj,jk) > 0.e0 ) THEN
306                     zflxi(3) = zflxi(3) +    zu
307                     ztemi(3) = ztemi(3) + zt*zu
308                     zsali(3) = zsali(3) + zs*zu
309                  ELSE
310                     zflxo(3) = zflxo(3) +    zu
311                     ztemo(3) = ztemo(3) + zt*zu
312                     zsalo(3) = zsalo(3) + zs*zu
313                  ENDIF
314               END DO
315            END DO
316         END DO
317      ENDIF
318
319      ! Mean flow at Baltic Sea entrance
320      IF( cp_cfg == "orca" ) THEN
321               
322         SELECT CASE ( jp_cfg )
323         !                                           ! =======================
324         CASE ( 4 )                                  !  ORCA_R4 configuration
325            !                                        ! =======================
326            ii0 = 1     ;   ii1 = 1 
327            ij0 = 1     ;   ij1 = 1 
328            !                                        ! =======================
329         CASE ( 2 )                                  !  ORCA_R2 configuration
330            !                                        ! =======================
331            ii0 = 146   ;   ii1 = 146 
332            ij0 = 116   ;   ij1 = 116
333            !                                        ! =======================
334         CASE ( 1 )                                  !  ORCA_R1 configurations
335            !                                        ! =======================
336            ! This dirty section will be suppressed by simplification process:
337            ! all this will come back in input files
338            ! Currently these hard-wired indices relate to configuration with
339            ! extend grid (jpjglo=332)
340            isrow = 332 - jpjglo
341            ii0 = 297           ;   ii1 = 297
342            ij0 = 269 - isrow   ;   ij1 = 269 - isrow
343            !                                        ! =======================
344         CASE DEFAULT                                !    ORCA R05 or R025
345            !                                        ! =======================
346            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
347            !
348         END SELECT
349         !
350         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
351            DO jj = mj0(ij0), mj1(ij1)
352               DO jk = 1, jpk
353                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
354                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
355                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
356                 
357                  IF( un(ji,jj,jk) > 0.e0 ) THEN
358                     zflxi(4) = zflxi(4) +    zu
359                     ztemi(4) = ztemi(4) + zt*zu
360                     zsali(4) = zsali(4) + zs*zu
361                  ELSE
362                     zflxo(4) = zflxo(4) +    zu
363                     ztemo(4) = ztemo(4) + zt*zu
364                     zsalo(4) = zsalo(4) + zs*zu
365                  ENDIF
366               END DO
367            END DO
368         END DO
369      ENDIF
370
371      ! Sum at each time-step
372      DO jt = 1, 4 
373         !
374         IF( zflxi(jt) /= 0.e0 ) THEN
375            a_flxi(jt) = a_flxi(jt) + zflxi(jt)
376            a_temi(jt) = a_temi(jt) + ztemi(jt)/zflxi(jt)
377            a_sali(jt) = a_sali(jt) + zsali(jt)/zflxi(jt)
378         ENDIF
379         !
380         IF( zflxo(jt) /= 0.e0 ) THEN
381            a_flxo(jt) = a_flxo(jt) + zflxo(jt)
382            a_temo(jt) = a_temo(jt) + ztemo(jt)/zflxo(jt)
383            a_salo(jt) = a_salo(jt) + zsalo(jt)/zflxo(jt)
384         ENDIF
385         !
386      END DO
387
388      IF( kt == nitend ) THEN
389         DO jt = 1, 4 
390            a_flxi(jt) = a_flxi(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 )
391            a_temi(jt) = a_temi(jt) /   FLOAT( nitend - nit000 + 1 )
392            a_sali(jt) = a_sali(jt) /   FLOAT( nitend - nit000 + 1 )
393            a_flxo(jt) = a_flxo(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 )
394            a_temo(jt) = a_temo(jt) /   FLOAT( nitend - nit000 + 1 )
395            a_salo(jt) = a_salo(jt) /   FLOAT( nitend - nit000 + 1 )
396         END DO
397         IF( lk_mpp ) THEN
398            CALL mpp_sum( a_flxi, 4 )      ! sum over the global domain
399            CALL mpp_sum( a_temi, 4 )      ! sum over the global domain
400            CALL mpp_sum( a_sali, 4 )      ! sum over the global domain
401
402            CALL mpp_sum( a_flxo, 4 )      ! sum over the global domain
403            CALL mpp_sum( a_temo, 4 )      ! sum over the global domain
404            CALL mpp_sum( a_salo, 4 )      ! sum over the global domain
405         ENDIF
406      ENDIF
407
408
409      ! Ecriture des diagnostiques
410      ! --------------------------
411
412      IF ( kt == nitend .AND. cp_cfg == "orca" .AND. lwp ) THEN
413
414         CALL ctl_opn( inum, 'STRAIT.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
415         WRITE(inum,*)
416         WRITE(inum,*)    'Net freshwater budget '
417         WRITE(inum,9010) '  fwf    = ',a_fwf,   ' m3 =', a_fwf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
418         WRITE(inum,*)
419         WRITE(inum,9010) '  zarea =',zarea
420         WRITE(inum,9010) '  zvol  =',zvol
421         WRITE(inum,*)
422         WRITE(inum,*)    'Mean sea level : '
423         WRITE(inum,9010) '  at nit000 = ',a_sshb        ,' m3 '
424         WRITE(inum,9010) '  at nitend = ',a_sshn        ,' m3 '
425         WRITE(inum,9010) '  diff      = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv'
426         WRITE(inum,9020) '  mean sea level elevation    =', a_sshn/zarea,' m'
427         WRITE(inum,*)
428         WRITE(inum,*)    'Anomaly of salinity content : '
429         WRITE(inum,9010) '  at nit000 = ',a_salb        ,' psu.m3 '
430         WRITE(inum,9010) '  at nitend = ',a_saln        ,' psu.m3 '
431         WRITE(inum,9010) '  diff      = ',(a_saln-a_salb),' psu.m3'
432         WRITE(inum,*)
433         WRITE(inum,*)    'Mean salinity : '
434         WRITE(inum,9020) '  at nit000 =',a_salb/zvol+zsm0   ,' psu '
435         WRITE(inum,9020) '  at nitend =',a_saln/zvol+zsm0   ,' psu '
436         WRITE(inum,9020) '  diff      =',(a_saln-a_salb)/zvol,' psu'
437         WRITE(inum,9020) '  S-SLevitus=',a_saln/zvol,' psu'
438         WRITE(inum,*)
439         WRITE(inum,*)    'Gibraltar : '
440         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(1)
441         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(1)
442         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(1)
443         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(1)
444         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(1)
445         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(1)
446         WRITE(inum,*)
447         WRITE(inum,*)    'Cadiz : '
448         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(2)
449         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(2)
450         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(2)
451         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(2)
452         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(2)
453         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(2)
454         WRITE(inum,*)
455         WRITE(inum,*)    'Bab el Mandeb : '
456         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(3)
457         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(3)
458         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(3)
459         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(3)
460         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(3)
461         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(3)
462         WRITE(inum,*)
463         WRITE(inum,*)    'Baltic : '
464         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(4)
465         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(4)
466         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(4)
467         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(4)
468         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(4)
469         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(4)
470         CLOSE(inum)
471      ENDIF
472
473      IF( nn_timing == 1 )   CALL timing_start('dia_fwb')
474
475 9005 FORMAT(1X,A,ES24.16)
476 9010 FORMAT(1X,A,ES12.5,A,F10.5,A)
477 9020 FORMAT(1X,A,F10.5,A)
478 9030 FORMAT(1X,A,F9.4,A)
479 
480      ENDIF
481
482      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
483   END SUBROUTINE dia_fwb
484
485   !!======================================================================
486END MODULE diafwb
Note: See TracBrowser for help on using the repository browser.