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/trunk/src/OCE/DIA – NEMO

source: NEMO/trunk/src/OCE/DIA/diahsb.F90 @ 12485

Last change on this file since 12485 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 22.7 KB
RevLine 
[2148]1MODULE diahsb
2   !!======================================================================
3   !!                       ***  MODULE  diahsb  ***
[2334]4   !! Ocean diagnostics: Heat, salt and volume budgets
[2148]5   !!======================================================================
[2334]6   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code
[4161]7   !!                 ! 2012-10  (C. Rousset)  add iom_put
[2148]8   !!----------------------------------------------------------------------
[2334]9
10   !!----------------------------------------------------------------------
[4990]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   !!----------------------------------------------------------------------
[9168]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
[12377]19   USE isf_oce        ! ice shelf fluxes
[9168]20   USE sbcrnf         ! river runoff
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
[4990]27   !
[9168]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
[2148]33
34   IMPLICIT NONE
35   PRIVATE
36
[2334]37   PUBLIC   dia_hsb        ! routine called by step.F90
[4161]38   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90
[2148]39
[4147]40   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets
[2148]41
[4990]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   !
[6140]46   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
47   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          !
[4990]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  !
[12377]50   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tmask_ini
[2148]51
52   !!----------------------------------------------------------------------
[9598]53   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2281]54   !! $Id$
[10068]55   !! Software governed by the CeCILL license (see ./LICENSE)
[2148]56   !!----------------------------------------------------------------------
57CONTAINS
58
[12377]59   SUBROUTINE dia_hsb( kt, Kbb, Kmm )
[2148]60      !!---------------------------------------------------------------------------
61      !!                  ***  ROUTINE dia_hsb  ***
62      !!     
[2334]63      !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation
[2148]64      !!
65      !! ** Method : - Compute the deviation of heat content, salt content and volume
[2334]66      !!             at the current time step from their values at nit000
67      !!             - Compute the contribution of forcing and remove it from these deviations
68      !!
[2148]69      !!---------------------------------------------------------------------------
[12377]70      INTEGER, INTENT(in) ::   kt         ! ocean time-step index
71      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
[4990]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         !    -     -
[9227]83      REAL(wp), DIMENSION(jpi,jpj)       ::   z2d0, z2d1   ! 2D workspace
84      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwrk         ! 3D workspace
[2148]85      !!---------------------------------------------------------------------------
[9124]86      IF( ln_timing )   CALL timing_start('dia_hsb')     
[7646]87      !
[12377]88      ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ;
89      ts(:,:,:,2,Kmm) = ts(:,:,:,2,Kmm) * tmask(:,:,:) ; ts(:,:,:,2,Kbb) = ts(:,:,:,2,Kbb) * tmask(:,:,:) ;
[2148]90      ! ------------------------- !
91      ! 1 - Trends due to forcing !
92      ! ------------------------- !
[12377]93      z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * surf(:,:) )   ! volume fluxes
[10425]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
[9227]96      !                    !  Add runoff    heat & salt input
[10425]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(:,:) )
[9227]99      !                    ! Add ice shelf heat & salt input
[12377]100      IF( ln_isf    )   z_frc_trd_t = z_frc_trd_t &
101         &                          + glob_sum( 'diahsb', ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) )
[9227]102      !                    ! Add penetrative solar radiation
[10425]103      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( 'diahsb', qsr     (:,:) * surf(:,:) )
[9227]104      !                    ! Add geothermal heat flux
[10425]105      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) )
[4161]106      !
[6140]107      IF( ln_linssh ) THEN
108         IF( ln_isfcav ) THEN
[5120]109            DO ji=1,jpi
110               DO jj=1,jpj
[12377]111                  z2d0(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb)
112                  z2d1(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb)
[6140]113               END DO
114            END DO
[5120]115         ELSE
[12377]116            z2d0(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_tem,Kbb)
117            z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb)
[5120]118         END IF
[10425]119         z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 
120         z_wn_trd_s = - glob_sum( 'diahsb', z2d1 )
[4558]121      ENDIF
122
[2148]123      frc_v = frc_v + z_frc_trd_v * rdt
124      frc_t = frc_t + z_frc_trd_t * rdt
125      frc_s = frc_s + z_frc_trd_s * rdt
[4558]126      !                                          ! Advection flux through fixed surface (z=0)
[6140]127      IF( ln_linssh ) THEN
[4558]128         frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
129         frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
130      ENDIF
[2148]131
[4161]132      ! ------------------------ !
[9227]133      ! 2 -  Content variations  !
[4161]134      ! ------------------------ !
[6140]135      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
[4558]136
[9227]137      !                    ! volume variation (calculated with ssh)
[12377]138      zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) )
[4558]139
[9227]140      !                    ! heat & salt content variation (associated with ssh)
141      IF( ln_linssh ) THEN       ! linear free surface case
142         IF( ln_isfcav ) THEN          ! ISF case
[5120]143            DO ji = 1, jpi
144               DO jj = 1, jpj
[12377]145                  z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 
146                  z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 
[5120]147               END DO
[4990]148            END DO
[9227]149         ELSE                          ! no under ice-shelf seas
[12377]150            z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 
151            z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 
[5120]152         END IF
[10425]153         z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 
154         z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 
[4558]155      ENDIF
[9227]156      !
[10425]157      DO jk = 1, jpkm1           ! volume variation (calculated with scale factors)
[12377]158         zwrk(:,:,jk) = surf(:,:)*e3t(:,:,jk,Kmm)*tmask(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk)*tmask_ini(:,:,jk)
[9227]159      END DO
[12377]160      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )     ! glob_sum_full needed as tmask and tmask_ini could be different
[9227]161      DO jk = 1, jpkm1           ! heat content variation
[12377]162         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) )
[9227]163      END DO
[10425]164      zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
[9227]165      DO jk = 1, jpkm1           ! salt content variation
[12377]166         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) )
[9227]167      END DO
[10425]168      zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
[4558]169
[7646]170      ! ------------------------ !
171      ! 3 -  Drifts              !
172      ! ------------------------ !
[4558]173      zdiff_v1 = zdiff_v1 - frc_v
[6140]174      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v
[4558]175      zdiff_hc = zdiff_hc - frc_t
176      zdiff_sc = zdiff_sc - frc_s
[6140]177      IF( ln_linssh ) THEN
[4558]178         zdiff_hc1 = zdiff_hc + z_ssh_hc 
179         zdiff_sc1 = zdiff_sc + z_ssh_sc
180         zerr_hc1  = z_ssh_hc - frc_wn_t
181         zerr_sc1  = z_ssh_sc - frc_wn_s
[4162]182      ENDIF
[4558]183
[2148]184      ! ----------------------- !
[7646]185      ! 4 - Diagnostics writing !
[4161]186      ! ----------------------- !
[9227]187      DO jk = 1, jpkm1           ! total ocean volume (calculated with scale factors)
[12377]188         zwrk(:,:,jk) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
[4558]189      END DO
[12377]190      zvol_tot = glob_sum( 'diahsb', zwrk(:,:,:) )
[4558]191
[4990]192!!gm to be added ?
[6140]193!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution
[12377]194!        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * ssh(:,:,Kmm) )
[4990]195!      ENDIF
196!!gm end
197
[7646]198      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)
199      CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J)
200      CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2)
201         &                       ( surf_tot * kt * rdt )        )
202      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3)
203
204      IF( .NOT. ln_linssh ) THEN
[9227]205         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C)
206         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (PSU)
207         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J)
208         CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2)
209            &                       ( surf_tot * kt * rdt )        )
210         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3)
211         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
212         CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3) 
213         !
214         IF( kt == nitend .AND. lwp ) THEN
215            WRITE(numout,*)
216            WRITE(numout,*) 'dia_hsb : last time step hsb diagnostics: at it= ', kt,' date= ', ndastp
217            WRITE(numout,*) '~~~~~~~'
218            WRITE(numout,*) '   Temperature drift = ', zdiff_hc / zvol_tot, ' C'
219            WRITE(numout,*) '   Salinity    drift = ', zdiff_sc / zvol_tot, ' PSU'
220            WRITE(numout,*) '   volume ssh  drift = ', zdiff_v1 * 1.e-9   , ' km^3'
221            WRITE(numout,*) '   volume e3t  drift = ', zdiff_v2 * 1.e-9   , ' km^3'
222         ENDIF
223         !
[7646]224      ELSE
[9227]225         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C)
226         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (PSU)
227         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J)
228         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2)
229            &                       ( surf_tot * kt * rdt )         )
230         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3)
231         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
232         CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C)
233         CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu)
[4162]234      ENDIF
[4558]235      !
[12377]236      IF( lrst_oce )   CALL dia_hsb_rst( kt, Kmm, 'WRITE' )
[6140]237      !
[9124]238      IF( ln_timing )   CALL timing_stop('dia_hsb')
[6140]239      !
[2148]240   END SUBROUTINE dia_hsb
241
[2334]242
[12377]243   SUBROUTINE dia_hsb_rst( kt, Kmm, cdrw )
[9169]244      !!---------------------------------------------------------------------
245      !!                   ***  ROUTINE dia_hsb_rst  ***
246      !!                     
247      !! ** Purpose :   Read or write DIA file in restart file
248      !!
249      !! ** Method  :   use of IOM library
250      !!----------------------------------------------------------------------
251      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
[12377]252      INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index
[9169]253      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
254      !
255      INTEGER ::   ji, jj, jk   ! dummy loop indices
256      !!----------------------------------------------------------------------
257      !
258      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
259         IF( ln_rstart ) THEN                   !* Read the restart file
260            !
261            IF(lwp) WRITE(numout,*)
262            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp
263            IF(lwp) WRITE(numout,*)
[9367]264            CALL iom_get( numror, 'frc_v', frc_v, ldxios = lrxios )
265            CALL iom_get( numror, 'frc_t', frc_t, ldxios = lrxios )
266            CALL iom_get( numror, 'frc_s', frc_s, ldxios = lrxios )
[9169]267            IF( ln_linssh ) THEN
[9367]268               CALL iom_get( numror, 'frc_wn_t', frc_wn_t, ldxios = lrxios )
269               CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios )
[9169]270            ENDIF
[9367]271            CALL iom_get( numror, jpdom_autoglo, 'surf_ini'  , surf_ini  , ldxios = lrxios ) ! ice sheet coupling
272            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini'   , ssh_ini   , ldxios = lrxios )
273            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini'   , e3t_ini   , ldxios = lrxios )
[12377]274            CALL iom_get( numror, jpdom_autoglo, 'tmask_ini' , tmask_ini , ldxios = lrxios )
[9367]275            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios )
276            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios )
[9169]277            IF( ln_linssh ) THEN
[9367]278               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios )
279               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios )
[9169]280            ENDIF
[9367]281         ELSE
[9169]282            IF(lwp) WRITE(numout,*)
283            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : initialise hsb at initial state '
284            IF(lwp) WRITE(numout,*)
285            surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
[12377]286            ssh_ini(:,:) = ssh(:,:,Kmm)                          ! initial ssh
[9169]287            DO jk = 1, jpk
288              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
[12377]289               e3t_ini   (:,:,jk) = e3t(:,:,jk,Kmm)                      * tmask(:,:,jk)  ! initial vertical scale factors
290               tmask_ini (:,:,jk) = tmask(:,:,jk)                                       ! initial mask
291               hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial heat content
292               sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial salt content
[9169]293            END DO
294            frc_v = 0._wp                                           ! volume       trend due to forcing
295            frc_t = 0._wp                                           ! heat content   -    -   -    -   
296            frc_s = 0._wp                                           ! salt content   -    -   -    -       
297            IF( ln_linssh ) THEN
298               IF( ln_isfcav ) THEN
299                  DO ji = 1, jpi
300                     DO jj = 1, jpj
[12377]301                        ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm)   ! initial heat content in ssh
302                        ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm)   ! initial salt content in ssh
[9169]303                     END DO
304                   END DO
305                ELSE
[12377]306                  ssh_hc_loc_ini(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm)   ! initial heat content in ssh
307                  ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm)   ! initial salt content in ssh
[9169]308               END IF
309               frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
310               frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface
311            ENDIF
312         ENDIF
313         !
314      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
315         !                                   ! -------------------
316         IF(lwp) WRITE(numout,*)
317         IF(lwp) WRITE(numout,*) '   dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp
318         IF(lwp) WRITE(numout,*)
319         !
[9367]320         IF( lwxios ) CALL iom_swap(      cwxios_context          )
321         CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v, ldxios = lwxios )
322         CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t, ldxios = lwxios )
323         CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s, ldxios = lwxios )
[9169]324         IF( ln_linssh ) THEN
[9367]325            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, ldxios = lwxios )
326            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, ldxios = lwxios )
[9169]327         ENDIF
[9367]328         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini'  , surf_ini  , ldxios = lwxios )      ! ice sheet coupling
329         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini'   , ssh_ini   , ldxios = lwxios )
330         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini'   , e3t_ini   , ldxios = lwxios )
[12377]331         CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios )
[9367]332         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, ldxios = lwxios )
333         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, ldxios = lwxios )
[9169]334         IF( ln_linssh ) THEN
[9367]335            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lwxios )
336            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lwxios )
[9169]337         ENDIF
[9367]338         IF( lwxios ) CALL iom_swap(      cxios_context          )
[9169]339         !
340      ENDIF
341      !
[4161]342   END SUBROUTINE dia_hsb_rst
[2148]343
[4990]344
[12377]345   SUBROUTINE dia_hsb_init( Kmm )
[4990]346      !!---------------------------------------------------------------------------
347      !!                  ***  ROUTINE dia_hsb  ***
348      !!     
349      !! ** Purpose: Initialization for the heat salt volume budgets
350      !!
351      !! ** Method : Compute initial heat content, salt content and volume
352      !!
353      !! ** Action : - Compute initial heat content, salt content and volume
354      !!             - Initialize forcing trends
355      !!             - Compute coefficients for conversion
356      !!---------------------------------------------------------------------------
[12377]357      INTEGER, INTENT(in) :: Kmm ! time level index
358      !
[9169]359      INTEGER ::   ierror, ios   ! local integer
[7646]360      !!
[4990]361      NAMELIST/namhsb/ ln_diahsb
362      !!----------------------------------------------------------------------
[7646]363      !
[9169]364      IF(lwp) THEN
365         WRITE(numout,*)
366         WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics'
367         WRITE(numout,*) '~~~~~~~~~~~~ '
368      ENDIF
[4990]369      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)
[11536]370901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist' )
[4990]371      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )
[11536]372902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist' )
[9169]373      IF(lwm) WRITE( numond, namhsb )
[4990]374
[7646]375      IF(lwp) THEN
[9168]376         WRITE(numout,*) '   Namelist  namhsb :'
377         WRITE(numout,*) '      check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb
[4990]378      ENDIF
[7646]379      !
[4990]380      IF( .NOT. ln_diahsb )   RETURN
381
[9367]382      IF(lwxios) THEN
383! define variables in restart file when writing with XIOS
384        CALL iom_set_rstw_var_active('frc_v')
385        CALL iom_set_rstw_var_active('frc_t')
386        CALL iom_set_rstw_var_active('frc_s')
387        CALL iom_set_rstw_var_active('surf_ini')
388        CALL iom_set_rstw_var_active('ssh_ini')
389        CALL iom_set_rstw_var_active('e3t_ini')
390        CALL iom_set_rstw_var_active('hc_loc_ini')
391        CALL iom_set_rstw_var_active('sc_loc_ini')
392        IF( ln_linssh ) THEN
393           CALL iom_set_rstw_var_active('ssh_hc_loc_ini')
394           CALL iom_set_rstw_var_active('ssh_sc_loc_ini')
395           CALL iom_set_rstw_var_active('frc_wn_t')
396           CALL iom_set_rstw_var_active('frc_wn_s')
397        ENDIF
398      ENDIF
[4990]399      ! ------------------- !
400      ! 1 - Allocate memory !
401      ! ------------------- !
[6140]402      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
[12377]403         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror  )
[4990]404      IF( ierror > 0 ) THEN
[7646]405         CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN
[4990]406      ENDIF
407
[6140]408      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
[4990]409      IF( ierror > 0 ) THEN
[7646]410         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' )   ;   RETURN
[4990]411      ENDIF
412
413      ! ----------------------------------------------- !
414      ! 2 - Time independant variables and file opening !
415      ! ----------------------------------------------- !
[10425]416      surf(:,:) = e1e2t(:,:) * tmask_i(:,:)               ! masked surface grid cell area
417      surf_tot  = glob_sum( 'diahsb', surf(:,:) )         ! total ocean surface area
[4990]418
[7646]419      IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )         
[4990]420      !
421      ! ---------------------------------- !
422      ! 4 - initial conservation variables !
423      ! ---------------------------------- !
[12377]424      CALL dia_hsb_rst( nit000, Kmm, 'READ' )  !* read or initialize all required files
[4990]425      !
426   END SUBROUTINE dia_hsb_init
427
[2148]428   !!======================================================================
429END MODULE diahsb
Note: See TracBrowser for help on using the repository browser.