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/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90 @ 3875

Last change on this file since 3875 was 3875, checked in by clevy, 11 years ago

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