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.
diahsb.F90 in NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DIA – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DIA/diahsb.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 21.9 KB
Line 
1MODULE diahsb
2   !!======================================================================
3   !!                       ***  MODULE  diahsb  ***
4   !! Ocean diagnostics: Heat, salt and volume budgets
5   !!======================================================================
6   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code
7   !!                 ! 2012-10  (C. Rousset)  add iom_put
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   dia_hsb       : Diagnose the conservation of ocean heat and salt contents, and volume
12   !!   dia_hsb_rst   : Read or write DIA file in restart file
13   !!   dia_hsb_init  : Initialization of the conservation diagnostic
14   !!----------------------------------------------------------------------
15   USE oce            ! ocean dynamics and tracers
16   USE dom_oce        ! ocean space and time domain
17   USE phycst         ! physical constants
18   USE sbc_oce        ! surface thermohaline fluxes
19   USE sbcrnf         ! river runoff
20   USE sbcisf         ! ice shelves
21   USE domvvl         ! vertical scale factors
22   USE traqsr         ! penetrative solar radiation
23   USE trabbc         ! bottom boundary condition
24   USE trabbc         ! bottom boundary condition
25   USE restart        ! ocean restart
26   USE bdy_oce , ONLY : ln_bdy
27   !
28   USE iom            ! I/O manager
29   USE in_out_manager ! I/O manager
30   USE lib_fortran    ! glob_sum
31   USE lib_mpp        ! distributed memory computing library
32   USE timing         ! preformance summary
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   dia_hsb        ! routine called by step.F90
38   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90
39
40   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets
41
42   REAL(wp) ::   surf_tot              ! ocean surface
43   REAL(wp) ::   frc_t, frc_s, frc_v   ! global forcing trends
44   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends
45   !
46   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
47   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          !
48   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   !
49   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
50
51   !! * Substitutions
52#  include "vectopt_loop_substitute.h90"
53   !!----------------------------------------------------------------------
54   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
55   !! $Id$
56   !! Software governed by the CeCILL license (see ./LICENSE)
57   !!----------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dia_hsb( kt )
61      !!---------------------------------------------------------------------------
62      !!                  ***  ROUTINE dia_hsb  ***
63      !!     
64      !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation
65      !!
66      !! ** Method : - Compute the deviation of heat content, salt content and volume
67      !!             at the current time step from their values at nit000
68      !!             - Compute the contribution of forcing and remove it from these deviations
69      !!
70      !!---------------------------------------------------------------------------
71      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
72      !
73      INTEGER    ::   ji, jj, jk                  ! dummy loop indice
74      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations
75      REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        -
76      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation
77      REAL(wp)   ::   zerr_hc1    , zerr_sc1      ! heat and salt content misfit
78      REAL(wp)   ::   zvol_tot                    ! volume
79      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     -
80      REAL(wp)   ::   z_frc_trd_v                 !    -     -
81      REAL(wp)   ::   z_wn_trd_t , z_wn_trd_s     !    -     -
82      REAL(wp)   ::   z_ssh_hc , z_ssh_sc         !    -     -
83      REAL(wp), DIMENSION(jpi,jpj)       ::   z2d0, z2d1   ! 2D workspace
84      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwrk         ! 3D workspace
85      !!---------------------------------------------------------------------------
86      IF( ln_timing )   CALL timing_start('dia_hsb')     
87      !
88      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;
89      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;
90      ! ------------------------- !
91      ! 1 - Trends due to forcing !
92      ! ------------------------- !
93      z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) )   ! volume fluxes
94      z_frc_trd_t =           glob_sum( 'diahsb', sbc_tsc(:,:,jp_tem) * surf(:,:) )                       ! heat fluxes
95      z_frc_trd_s =           glob_sum( 'diahsb', sbc_tsc(:,:,jp_sal) * surf(:,:) )                       ! salt fluxes
96      !                    !  Add runoff    heat & salt input
97      IF( ln_rnf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', rnf_tsc(:,:,jp_tem) * surf(:,:) )
98      IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) )
99      !                    ! Add ice shelf heat & salt input
100      IF( ln_isf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', risf_tsc(:,:,jp_tem) * surf(:,:) )
101      !                    ! Add penetrative solar radiation
102      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( 'diahsb', qsr     (:,:) * surf(:,:) )
103      !                    ! Add geothermal heat flux
104      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) )
105      !
106      IF( ln_linssh ) THEN
107         IF( ln_isfcav ) THEN
108            DO ji=1,jpi
109               DO jj=1,jpj
110                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
111                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
112               END DO
113            END DO
114         ELSE
115            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
116            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
117         END IF
118         z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 
119         z_wn_trd_s = - glob_sum( 'diahsb', z2d1 )
120      ENDIF
121
122      frc_v = frc_v + z_frc_trd_v * rdt
123      frc_t = frc_t + z_frc_trd_t * rdt
124      frc_s = frc_s + z_frc_trd_s * rdt
125      !                                          ! Advection flux through fixed surface (z=0)
126      IF( ln_linssh ) THEN
127         frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
128         frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
129      ENDIF
130
131      ! ------------------------ !
132      ! 2 -  Content variations  !
133      ! ------------------------ !
134      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
135
136      !                    ! volume variation (calculated with ssh)
137      zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*sshn(:,:) - surf_ini(:,:)*ssh_ini(:,:) )
138
139      !                    ! heat & salt content variation (associated with ssh)
140      IF( ln_linssh ) THEN       ! linear free surface case
141         IF( ln_isfcav ) THEN          ! ISF case
142            DO ji = 1, jpi
143               DO jj = 1, jpj
144                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
145                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
146               END DO
147            END DO
148         ELSE                          ! no under ice-shelf seas
149            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 
150            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
151         END IF
152         z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 
153         z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 
154      ENDIF
155      !
156      DO jk = 1, jpkm1           ! volume variation (calculated with scale factors)
157         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk)
158      END DO
159      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )
160      DO jk = 1, jpkm1           ! heat content variation
161         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_tem) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
162      END DO
163      zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
164      DO jk = 1, jpkm1           ! salt content variation
165         zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_sal) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
166      END DO
167      zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
168
169      ! ------------------------ !
170      ! 3 -  Drifts              !
171      ! ------------------------ !
172      zdiff_v1 = zdiff_v1 - frc_v
173      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v
174      zdiff_hc = zdiff_hc - frc_t
175      zdiff_sc = zdiff_sc - frc_s
176      IF( ln_linssh ) THEN
177         zdiff_hc1 = zdiff_hc + z_ssh_hc 
178         zdiff_sc1 = zdiff_sc + z_ssh_sc
179         zerr_hc1  = z_ssh_hc - frc_wn_t
180         zerr_sc1  = z_ssh_sc - frc_wn_s
181      ENDIF
182
183      ! ----------------------- !
184      ! 4 - Diagnostics writing !
185      ! ----------------------- !
186      DO jk = 1, jpkm1           ! total ocean volume (calculated with scale factors)
187         zwrk(:,:,jk) = surf(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
188      END DO
189      zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) )
190
191!!gm to be added ?
192!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution
193!        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * sshn(:,:) )
194!      ENDIF
195!!gm end
196
197      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)
198      CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J)
199      CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2)
200         &                       ( surf_tot * kt * rdt )        )
201      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3)
202
203      IF( .NOT. ln_linssh ) THEN
204         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C)
205         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (PSU)
206         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J)
207         CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2)
208            &                       ( surf_tot * kt * rdt )        )
209         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3)
210         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
211         CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3) 
212         !
213         IF( kt == nitend .AND. lwp ) THEN
214            WRITE(numout,*)
215            WRITE(numout,*) 'dia_hsb : last time step hsb diagnostics: at it= ', kt,' date= ', ndastp
216            WRITE(numout,*) '~~~~~~~'
217            WRITE(numout,*) '   Temperature drift = ', zdiff_hc / zvol_tot, ' C'
218            WRITE(numout,*) '   Salinity    drift = ', zdiff_sc / zvol_tot, ' PSU'
219            WRITE(numout,*) '   volume ssh  drift = ', zdiff_v1 * 1.e-9   , ' km^3'
220            WRITE(numout,*) '   volume e3t  drift = ', zdiff_v2 * 1.e-9   , ' km^3'
221         ENDIF
222         !
223      ELSE
224         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C)
225         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (PSU)
226         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J)
227         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2)
228            &                       ( surf_tot * kt * rdt )         )
229         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3)
230         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
231         CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C)
232         CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu)
233      ENDIF
234      !
235      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' )
236      !
237      IF( ln_timing )   CALL timing_stop('dia_hsb')
238      !
239   END SUBROUTINE dia_hsb
240
241
242   SUBROUTINE dia_hsb_rst( kt, cdrw )
243      !!---------------------------------------------------------------------
244      !!                   ***  ROUTINE dia_hsb_rst  ***
245      !!                     
246      !! ** Purpose :   Read or write DIA file in restart file
247      !!
248      !! ** Method  :   use of IOM library
249      !!----------------------------------------------------------------------
250      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
251      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
252      !
253      INTEGER ::   ji, jj, jk   ! dummy loop indices
254      !!----------------------------------------------------------------------
255      !
256      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
257         IF( ln_rstart ) THEN                   !* Read the restart file
258            !
259            IF(lwp) WRITE(numout,*)
260            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp
261            IF(lwp) WRITE(numout,*)
262            CALL iom_get( numror, 'frc_v', frc_v, ldxios = lrxios )
263            CALL iom_get( numror, 'frc_t', frc_t, ldxios = lrxios )
264            CALL iom_get( numror, 'frc_s', frc_s, ldxios = lrxios )
265            IF( ln_linssh ) THEN
266               CALL iom_get( numror, 'frc_wn_t', frc_wn_t, ldxios = lrxios )
267               CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios )
268            ENDIF
269            CALL iom_get( numror, jpdom_autoglo, 'surf_ini'  , surf_ini  , ldxios = lrxios ) ! ice sheet coupling
270            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini'   , ssh_ini   , ldxios = lrxios )
271            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini'   , e3t_ini   , ldxios = lrxios )
272            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios )
273            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios )
274            IF( ln_linssh ) THEN
275               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios )
276               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios )
277            ENDIF
278         ELSE
279            IF(lwp) WRITE(numout,*)
280            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : initialise hsb at initial state '
281            IF(lwp) WRITE(numout,*)
282            surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
283            ssh_ini(:,:) = sshn(:,:)                          ! initial ssh
284            DO jk = 1, jpk
285              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
286               e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors
287               hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content
288               sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content
289            END DO
290            frc_v = 0._wp                                           ! volume       trend due to forcing
291            frc_t = 0._wp                                           ! heat content   -    -   -    -   
292            frc_s = 0._wp                                           ! salt content   -    -   -    -       
293            IF( ln_linssh ) THEN
294               IF( ln_isfcav ) THEN
295                  DO ji = 1, jpi
296                     DO jj = 1, jpj
297                        ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
298                        ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
299                     END DO
300                   END DO
301                ELSE
302                  ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh
303                  ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh
304               END IF
305               frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
306               frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface
307            ENDIF
308         ENDIF
309         !
310      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
311         !                                   ! -------------------
312         IF(lwp) WRITE(numout,*)
313         IF(lwp) WRITE(numout,*) '   dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp
314         IF(lwp) WRITE(numout,*)
315         !
316         IF( lwxios ) CALL iom_swap(      cwxios_context          )
317         CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v, ldxios = lwxios )
318         CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t, ldxios = lwxios )
319         CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s, ldxios = lwxios )
320         IF( ln_linssh ) THEN
321            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, ldxios = lwxios )
322            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, ldxios = lwxios )
323         ENDIF
324         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini'  , surf_ini  , ldxios = lwxios )      ! ice sheet coupling
325         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini'   , ssh_ini   , ldxios = lwxios )
326         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini'   , e3t_ini   , ldxios = lwxios )
327         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, ldxios = lwxios )
328         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, ldxios = lwxios )
329         IF( ln_linssh ) THEN
330            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lwxios )
331            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lwxios )
332         ENDIF
333         IF( lwxios ) CALL iom_swap(      cxios_context          )
334         !
335      ENDIF
336      !
337   END SUBROUTINE dia_hsb_rst
338
339
340   SUBROUTINE dia_hsb_init
341      !!---------------------------------------------------------------------------
342      !!                  ***  ROUTINE dia_hsb  ***
343      !!     
344      !! ** Purpose: Initialization for the heat salt volume budgets
345      !!
346      !! ** Method : Compute initial heat content, salt content and volume
347      !!
348      !! ** Action : - Compute initial heat content, salt content and volume
349      !!             - Initialize forcing trends
350      !!             - Compute coefficients for conversion
351      !!---------------------------------------------------------------------------
352      INTEGER ::   ierror, ios   ! local integer
353      !!
354      NAMELIST/namhsb/ ln_diahsb
355      !!----------------------------------------------------------------------
356      !
357      IF(lwp) THEN
358         WRITE(numout,*)
359         WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics'
360         WRITE(numout,*) '~~~~~~~~~~~~ '
361      ENDIF
362      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)
363901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist' )
364      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )
365902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist' )
366      IF(lwm) WRITE( numond, namhsb )
367
368      IF(lwp) THEN
369         WRITE(numout,*) '   Namelist  namhsb :'
370         WRITE(numout,*) '      check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb
371      ENDIF
372      !
373      IF( .NOT. ln_diahsb )   RETURN
374
375      IF(lwxios) THEN
376! define variables in restart file when writing with XIOS
377        CALL iom_set_rstw_var_active('frc_v')
378        CALL iom_set_rstw_var_active('frc_t')
379        CALL iom_set_rstw_var_active('frc_s')
380        CALL iom_set_rstw_var_active('surf_ini')
381        CALL iom_set_rstw_var_active('ssh_ini')
382        CALL iom_set_rstw_var_active('e3t_ini')
383        CALL iom_set_rstw_var_active('hc_loc_ini')
384        CALL iom_set_rstw_var_active('sc_loc_ini')
385        IF( ln_linssh ) THEN
386           CALL iom_set_rstw_var_active('ssh_hc_loc_ini')
387           CALL iom_set_rstw_var_active('ssh_sc_loc_ini')
388           CALL iom_set_rstw_var_active('frc_wn_t')
389           CALL iom_set_rstw_var_active('frc_wn_s')
390        ENDIF
391      ENDIF
392      ! ------------------- !
393      ! 1 - Allocate memory !
394      ! ------------------- !
395      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
396         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  )
397      IF( ierror > 0 ) THEN
398         CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN
399      ENDIF
400
401      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
402      IF( ierror > 0 ) THEN
403         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' )   ;   RETURN
404      ENDIF
405
406      ! ----------------------------------------------- !
407      ! 2 - Time independant variables and file opening !
408      ! ----------------------------------------------- !
409      surf(:,:) = e1e2t(:,:) * tmask_i(:,:)               ! masked surface grid cell area
410      surf_tot  = glob_sum( 'diahsb', surf(:,:) )         ! total ocean surface area
411
412      IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )         
413      !
414      ! ---------------------------------- !
415      ! 4 - initial conservation variables !
416      ! ---------------------------------- !
417      CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files
418      !
419   END SUBROUTINE dia_hsb_init
420
421   !!======================================================================
422END MODULE diahsb
Note: See TracBrowser for help on using the repository browser.