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.
sbcssr.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/sbcssr.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: 12.3 KB
Line 
1MODULE sbcssr
2   !!======================================================================
3   !!                       ***  MODULE  sbcssr  ***
4   !! Surface module :  heat and fresh water fluxes a restoring term toward observed SST/SSS
5   !!======================================================================
6   !! History :  3.0  !  2006-06  (G. Madec)  Original code
7   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology
12   !!   sbc_ssr_init  : initialisation of surface restoring
13   !!----------------------------------------------------------------------
14   USE oce            ! ocean dynamics and tracers
15   USE dom_oce        ! ocean space and time domain
16   USE sbc_oce        ! surface boundary condition
17   USE phycst         ! physical constants
18   USE sbcrnf         ! surface boundary condition : runoffs
19   !
20   USE fldread        ! read input fields
21   USE iom            ! I/O manager
22   USE in_out_manager ! I/O manager
23   USE lib_mpp        ! distribued memory computing library
24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
25   USE timing         ! Timing
26   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   sbc_ssr        ! routine called in sbcmod
32   PUBLIC   sbc_ssr_init   ! routine called in sbcmod
33
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s]
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2]
36
37   !                                   !!* Namelist namsbc_ssr *
38   INTEGER, PUBLIC ::   nn_sstr         ! SST/SSS restoring indicator
39   INTEGER, PUBLIC ::   nn_sssr         ! SST/SSS restoring indicator
40   REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS
41   REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS
42   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term
43   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
44
45   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
47   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
48
49   !! * Substitutions
50#  include "domzgr_substitute.h90"
51   !!----------------------------------------------------------------------
52   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
53   !! $Id$
54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE sbc_ssr( kt )
59      !!---------------------------------------------------------------------
60      !!                     ***  ROUTINE sbc_ssr  ***
61      !!
62      !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term
63      !!                toward observed SST and/or SSS.
64      !!
65      !! ** Method  : - Read namelist namsbc_ssr
66      !!              - Read observed SST and/or SSS
67      !!              - at each nscb time step
68      !!                   add a retroaction term on qns    (nn_sstr = 1)
69      !!                   add a damping term on sfx        (nn_sssr = 1)
70      !!                   add a damping term on emp        (nn_sssr = 2)
71      !!---------------------------------------------------------------------
72      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
73      !!
74      INTEGER  ::   ji, jj   ! dummy loop indices
75      REAL(wp) ::   zerp     ! local scalar for evaporation damping
76      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
77      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
78      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
79      INTEGER  ::   ierror   ! return error code
80      !!
81      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
82      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
83      !!----------------------------------------------------------------------
84      !
85      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr')
86      !
87      IF( nn_sstr + nn_sssr /= 0 ) THEN
88         !
89         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it at kt
90         IF( nn_sssr >= 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it at kt
91         !
92         !                                         ! ========================= !
93         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
94            !                                      ! ========================= !
95            !
96            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
97               DO jj = 1, jpj
98                  DO ji = 1, jpi
99                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
100                     qns(ji,jj) = qns(ji,jj) + zqrp
101                     qrp(ji,jj) = zqrp
102                  END DO
103               END DO
104               CALL iom_put( "qrp", qrp )                             ! heat flux damping
105            ENDIF
106            !
107            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
108               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
109!CDIR COLLAPSE
110               DO jj = 1, jpj
111                  DO ji = 1, jpi
112                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
113                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) 
114                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
115                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
116                  END DO
117               END DO
118               CALL iom_put( "erp", erp )                             ! freshwater flux damping
119               !
120            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
121               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
122               zerp_bnd = rn_sssr_bnd / rday                          !       -              -   
123!CDIR COLLAPSE
124               DO jj = 1, jpj
125                  DO ji = 1, jpi                           
126                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
127                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
128                        &        / MAX(  sss_m(ji,jj), 1.e-20   )
129                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
130                     emp(ji,jj) = emp (ji,jj) + zerp
131                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
132                     erp(ji,jj) = zerp
133                  END DO
134               END DO
135               CALL iom_put( "erp", erp )                             ! freshwater flux damping
136            ENDIF
137            !
138         ENDIF
139         !
140      ENDIF
141      !
142      IF( nn_timing == 1 )  CALL timing_stop('sbc_ssr')
143      !
144   END SUBROUTINE sbc_ssr
145
146 
147   SUBROUTINE sbc_ssr_init
148      !!---------------------------------------------------------------------
149      !!                  ***  ROUTINE sbc_ssr_init  ***
150      !!
151      !! ** Purpose :   initialisation of surface damping term
152      !!
153      !! ** Method  : - Read namelist namsbc_ssr
154      !!              - Read observed SST and/or SSS if required
155      !!---------------------------------------------------------------------
156      INTEGER  ::   ji, jj   ! dummy loop indices
157      REAL(wp) ::   zerp     ! local scalar for evaporation damping
158      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
159      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
160      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
161      INTEGER  ::   ierror   ! return error code
162      !!
163      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
164      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
165      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
166      INTEGER     ::  ios
167      !!----------------------------------------------------------------------
168      !
169 
170      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :
171      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
172901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp )
173
174      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist :
175      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 )
176902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp )
177      IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc_ssr )
178
179      IF(lwp) THEN                 !* control print
180         WRITE(numout,*)
181         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
182         WRITE(numout,*) '~~~~~~~ '
183         WRITE(numout,*) '   Namelist namsbc_ssr :'
184         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr
185         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr
186         WRITE(numout,*) '                       (Yes=2, volume flux) '
187         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K'
188         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day'
189         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
190         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
191         IF(lflush) CALL flush(numout)
192      ENDIF
193      !
194      !                            !* Allocate erp and qrp array
195      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
196      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
197      !
198      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays
199         !
200         ALLOCATE( sf_sst(1), STAT=ierror )
201         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )
202         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
203         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )
204         !
205         ! fill sf_sst with sn_sst and control print
206         CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
207         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )
208         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )
209         !
210      ENDIF
211      !
212      IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays
213         !
214         ALLOCATE( sf_sss(1), STAT=ierror )
215         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )
216         ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )
217         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )
218         !
219         ! fill sf_sss with sn_sss and control print
220         CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
221         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )
222         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )
223         !
224      ENDIF
225      !
226      !                            !* Initialize qrp and erp if no restoring
227      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
228      IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
229      !
230   END SUBROUTINE sbc_ssr_init
231     
232   !!======================================================================
233END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.