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

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90 @ 4769

Last change on this file since 4769 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
  • Property svn:keywords set to Id
File size: 12.2 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         ! SST/SSS restoring indicator
37   INTEGER, PUBLIC ::   nn_sssr         ! SST/SSS restoring indicator
38   REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS
39   REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS
40   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term
41   REAL(wp)        ::   rn_sssr_bnd     ! 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 
169      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :
170      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
171901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp )
172
173      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist :
174      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 )
175902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp )
176      IF(lwm) WRITE ( numond, namsbc_ssr )
177
178      IF(lwp) THEN                 !* control print
179         WRITE(numout,*)
180         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
181         WRITE(numout,*) '~~~~~~~ '
182         WRITE(numout,*) '   Namelist namsbc_ssr :'
183         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr
184         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr
185         WRITE(numout,*) '                       (Yes=2, volume flux) '
186         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K'
187         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day'
188         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
189         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
190      ENDIF
191      !
192      !                            !* Allocate erp and qrp array
193      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
194      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
195      !
196      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays
197         !
198         ALLOCATE( sf_sst(1), STAT=ierror )
199         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )
200         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
201         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )
202         !
203         ! fill sf_sst with sn_sst and control print
204         CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
205         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )
206         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )
207         !
208      ENDIF
209      !
210      IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays
211         !
212         ALLOCATE( sf_sss(1), STAT=ierror )
213         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )
214         ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )
215         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )
216         !
217         ! fill sf_sss with sn_sss and control print
218         CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
219         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )
220         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )
221         !
222      ENDIF
223      !
224      !                            !* Initialize qrp and erp if no restoring
225      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
226      IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
227      !
228   END SUBROUTINE sbc_ssr_init
229     
230   !!======================================================================
231END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.