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.
sbcssm.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 13.7 KB
Line 
1MODULE sbcssm
2   !!======================================================================
3   !!                       ***  MODULE  sbcssm  ***
4   !! Surface module :  provide time-mean ocean surface variables
5   !!======================================================================
6   !! History :  9.0  ! 2006-07  (G. Madec)  Original code
7   !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   sbc_ssm        : calculate sea surface mean currents, temperature, 
12   !!                    and salinity over nn_fsbc time-step
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
16   USE sbc_oce         ! surface boundary condition: ocean fields
17   USE sbcapr          ! surface boundary condition: atmospheric pressure
18   USE eosbn2          ! equation of state and related derivatives
19   !
20   USE in_out_manager  ! I/O manager
21   USE prtctl          ! Print control
22   USE iom             ! IOM library
23   USE timing
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   sbc_ssm         ! routine called by step.F90
29   PUBLIC   sbc_ssm_init    ! routine called by sbcmod.F90
30
31   LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read
32                                                  ! from restart file
33   
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36   !!----------------------------------------------------------------------
37   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE sbc_ssm( kt )
44      !!---------------------------------------------------------------------
45      !!                     ***  ROUTINE sbc_oce  ***
46      !!                     
47      !! ** Purpose :   provide ocean surface variable to sea-surface boundary
48      !!                condition computation
49      !!               
50      !! ** Method  :   compute mean surface velocity (2 components at U and
51      !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over
52      !!      the periode (kt - nn_fsbc) to kt
53      !!         Note that the inverse barometer ssh (i.e. ssh associated with Patm)
54      !!      is add to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.
55      !!---------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt   ! ocean time step
57      !
58      INTEGER  ::   ji, jj               ! loop index
59      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
60      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
61      !!---------------------------------------------------------------------
62
63      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
64      DO jj = 1, jpj
65         DO ji = 1, jpi
66            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
67            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
68         END DO
69      END DO
70      !
71      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
72         !                                                ! ---------------------------------------- !
73         ssu_m(:,:) = ub(:,:,1)
74         ssv_m(:,:) = vb(:,:,1)
75         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
76         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
77         ENDIF
78         sss_m(:,:) = zts(:,:,jp_sal)
79         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
80         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
81         ELSE                    ;   ssh_m(:,:) = sshn(:,:)
82         ENDIF
83         !
84         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
85         !
86         frq_m(:,:) = fraqsr_1lev(:,:)
87         !
88      ELSE
89         !                                                ! ----------------------------------------------- !
90         IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN   !   Initialisation: 1st time-step, no input means !
91            !                                             ! ----------------------------------------------- !
92            IF(lwp) WRITE(numout,*)
93            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
94            IF(lwp .AND. lflush) CALL flush(numout)
95            zcoef = REAL( nn_fsbc - 1, wp )
96            ssu_m(:,:) = zcoef * ub(:,:,1)
97            ssv_m(:,:) = zcoef * vb(:,:,1)
98            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
99            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
100            ENDIF
101            sss_m(:,:) = zcoef * zts(:,:,jp_sal)
102            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
103            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
104            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
105            ENDIF
106            !
107            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1)
108            !
109            frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
110            !                                             ! ---------------------------------------- !
111         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
112            !                                             ! ---------------------------------------- !
113            ssu_m(:,:) = 0.e0      ! reset to zero ocean mean sbc fields
114            ssv_m(:,:) = 0.e0
115            sst_m(:,:) = 0.e0
116            sss_m(:,:) = 0.e0
117            ssh_m(:,:) = 0.e0
118            IF( lk_vvl )   e3t_m(:,:) = 0.e0
119            frq_m(:,:) = 0.e0
120         ENDIF
121         !                                                ! ---------------------------------------- !
122         !                                                !        Cumulate at each time step        !
123         !                                                ! ---------------------------------------- !
124         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
125         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
126         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
127         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
128         ENDIF
129         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal)
130         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
131         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
132         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
133         ENDIF
134         !
135         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
136         !
137         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:)
138
139         !                                                ! ---------------------------------------- !
140         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
141            !                                             ! ---------------------------------------- !
142            zcoef = 1. / REAL( nn_fsbc, wp )
143            sst_m(:,:) = sst_m(:,:) * zcoef           ! mean SST             [Celcius]
144            sss_m(:,:) = sss_m(:,:) * zcoef           ! mean SSS             [psu]
145            ssu_m(:,:) = ssu_m(:,:) * zcoef           ! mean suface current  [m/s]
146            ssv_m(:,:) = ssv_m(:,:) * zcoef           !
147            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m]
148            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
149            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-]
150            !
151         ENDIF
152         !                                                ! ---------------------------------------- !
153         IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
154            !                                             ! ---------------------------------------- !
155            IF(lwp) WRITE(numout,*)
156            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields written in ocean restart file ',   &
157               &                    'at it= ', kt,' date= ', ndastp
158            IF(lwp) WRITE(numout,*) '~~~~~~~'
159            IF(lwp .AND. lflush) CALL flush(numout)
160            zf_sbc = REAL( nn_fsbc, wp )
161            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
162            CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc )    ! sbc frequency
163            CALL iom_rstput( kt, nitrst, numrow, 'ssu_m'  , ssu_m  )    ! sea surface mean fields
164            CALL iom_rstput( kt, nitrst, numrow, 'ssv_m'  , ssv_m  )
165            CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m  )
166            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  )
167            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )
168            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
169            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  )
170            IF(nn_timing == 2)  CALL timing_stop('iom_rstput') 
171            !
172         ENDIF
173         !
174      ENDIF
175      !
176      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
177         CALL iom_put( 'ssu_m', ssu_m )
178         CALL iom_put( 'ssv_m', ssv_m )
179         CALL iom_put( 'sst_m', sst_m )
180         CALL iom_put( 'sss_m', sss_m )
181         CALL iom_put( 'ssh_m', ssh_m )
182         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m )
183         CALL iom_put( 'frq_m', frq_m )
184      ENDIF
185      !
186   END SUBROUTINE sbc_ssm
187
188   SUBROUTINE sbc_ssm_init
189      !!----------------------------------------------------------------------
190      !!                  ***  ROUTINE sbc_ssm_init  ***
191      !!
192      !! ** Purpose :   Initialisation of the sbc data
193      !!
194      !! ** Action  : - read parameters
195      !!----------------------------------------------------------------------
196      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
197      !!----------------------------------------------------------------------
198
199      IF( nn_fsbc == 1 ) THEN
200         !
201         IF(lwp) WRITE(numout,*)
202         IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values'
203         IF(lwp) WRITE(numout,*) '~~~~~~~ '
204         !
205      ELSE
206         !               
207         IF(lwp) WRITE(numout,*)
208         IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields'
209         IF(lwp) WRITE(numout,*) '~~~~~~~ '
210         !
211         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN
212            l_ssm_mean = .TRUE.
213            IF(nn_timing == 2)  CALL timing_start('iom_rstget')
214            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )   ! sbc frequency of previous run
215            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )   ! sea surface mean velocity    (T-point)
216            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )   !   "         "    velocity    (V-point)
217            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )   !   "         "    temperature (T-point)
218            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
219            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
220            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )
221            ! fraction of solar net radiation absorbed in 1st T level
222            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
223               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  )
224            ELSE
225               frq_m(:,:) = 1._wp   ! default definition
226            ENDIF
227            IF(nn_timing == 2)  CALL timing_stop('iom_rstget')
228            !
229            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
230               IF(lwp) WRITE(numout,*) '~~~~~~~   restart with a change in the frequency of mean ',   &
231                  &                    'from ', zf_sbc, ' to ', nn_fsbc 
232               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 
233               ssu_m(:,:) = zcoef * ssu_m(:,:) 
234               ssv_m(:,:) = zcoef * ssv_m(:,:)
235               sst_m(:,:) = zcoef * sst_m(:,:)
236               sss_m(:,:) = zcoef * sss_m(:,:)
237               ssh_m(:,:) = zcoef * ssh_m(:,:)
238               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:)
239               frq_m(:,:) = zcoef * frq_m(:,:)
240            ELSE
241               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
242            ENDIF
243         ENDIF
244      ENDIF
245      !
246      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate
247         !
248         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays'
249         ssu_m(:,:) = ub(:,:,1)
250         ssv_m(:,:) = vb(:,:,1)
251         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
252         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
253         ENDIF
254         sss_m(:,:) = tsn(:,:,1,jp_sal)
255         ssh_m(:,:) = sshn(:,:)
256         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
257         frq_m(:,:) = 1._wp
258         !
259      ENDIF
260      !
261      IF(lwp .AND. lflush) CALL flush(numout)
262      !
263   END SUBROUTINE sbc_ssm_init
264
265   !!======================================================================
266END MODULE sbcssm
Note: See TracBrowser for help on using the repository browser.