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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/SBC – NEMO

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