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

source: branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcssr.F90 @ 1806

Last change on this file since 1806 was 1806, checked in by cbricaud, 14 years ago

developement that is running with running with nemoref on 19022010

  • Property svn:keywords set to Id
File size: 10.6 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
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   sbc_ssr    ! routine called in sbcmod
28   
29
30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   erp      !: evaporation damping   [kg/m2/s]
31   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp      !: heat flux damping        [w/m2]
32
33   !                                           !!* Namelist namsbc_ssr *
34   INTEGER, PUBLIC ::   nn_sstr     =   0       ! SST/SSS restoring indicator
35   INTEGER, PUBLIC ::   nn_sssr     =   0       ! SST/SSS restoring indicator
36   REAL(wp)        ::   rn_dqdt     = -40.e0    ! restoring factor on SST and SSS
37   REAL(wp)        ::   rn_deds     = -27.70    ! restoring factor on SST and SSS
38   LOGICAL         ::   ln_sssr_bnd = .false.   ! flag to bound erp term
39   REAL(wp)        ::   rn_sssr_bnd =   0.e0    ! ABS(Max./Min.) value of erp term [mm/day]
40
41   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
42   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
43   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
44
45   !! * Substitutions
46#  include "domzgr_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
49   !! $Id$
50   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
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 emps       (nn_sssr = 1)
67      !!                   add a damping term on emp & emps (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      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
81      !!----------------------------------------------------------------------
82      !
83      !                                               ! -------------------- !
84      IF( kt == nit000 ) THEN                         ! First call kt=nit000 !
85         !                                            ! -------------------- !
86         !                            !* set file information
87         cn_dir  = './'            ! directory in which the model is executed
88         ! ... default values (NB: frequency positive => hours, negative => months)
89         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
90         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
91         sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
92         sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
93
94         REWIND ( numnam )            !* read in namlist namflx
95         READ( numnam, namsbc_ssr ) 
96
97         IF(lwp) THEN                 !* control print
98            WRITE(numout,*)
99            WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
100            WRITE(numout,*) '~~~~~~~ '
101            WRITE(numout,*) '   Namelist namsbc_ssr :'
102            WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr
103            WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr
104            WRITE(numout,*) '                       (Yes=2, volume flux) '
105            WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K'
106            WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day'
107            WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
108            WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
109         ENDIF
110
111         IF( nn_sstr == 1 ) THEN      !* set sf_sst structure
112            !
113            ALLOCATE( sf_sst(1), STAT=ierror )
114            IF( ierror > 0 ) THEN
115               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
116            ENDIF
117            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) )
118            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )
119            !
120            ! fill sf_sst with sn_sst and control print
121            CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
122         ENDIF
123         !
124         IF( nn_sssr >= 1 ) THEN      ! set sf_sss structure
125            !
126            ALLOCATE( sf_sss(1), STAT=ierror )
127            IF( ierror > 0 ) THEN
128               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
129            ENDIF
130            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) )
131            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )
132            !
133            ! fill sf_sss with sn_sss and control print
134            CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
135         ENDIF
136         !
137         ! Initialize qrp and erp if no restoring
138         IF( nn_sstr /= 1                   )   qrp(:,:) = 0.e0 
139         IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0 
140      ENDIF
141
142      IF( nn_sstr + nn_sssr /= 0 ) THEN
143         !
144         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it at kt
145         IF( nn_sssr >= 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it at kt
146         !
147         !                                         ! ========================= !
148         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
149            !                                      ! ========================= !
150            !
151            IF( nn_sstr == 1 ) THEN                   !* Temperature restoring term
152!CDIR COLLAPSE
153               DO jj = 1, jpj
154                  DO ji = 1, jpi
155                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
156                     qns(ji,jj) = qns(ji,jj) + zqrp
157                     qrp(ji,jj) = zqrp
158                  END DO
159               END DO
160               CALL iom_put( "qrp", qrp )                             ! heat flux damping
161            ENDIF
162            !
163            IF( nn_sssr == 1 ) THEN                   !* Salinity damping term (salt flux, emps only)
164               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
165!CDIR COLLAPSE
166               DO jj = 1, jpj
167                  DO ji = 1, jpi
168                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
169                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
170                        &        / ( sss_m(ji,jj) + 1.e-20   )
171                     emps(ji,jj) = emps(ji,jj) + zerp
172                     erp( ji,jj) = zerp
173                  END DO
174               END DO
175               CALL iom_put( "erp", erp )                             ! freshwater flux damping
176               !
177            ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps)
178               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
179               zerp_bnd = rn_sssr_bnd / rday                          !       -              -   
180!CDIR COLLAPSE
181               DO jj = 1, jpj
182                  DO ji = 1, jpi                           
183                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
184                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
185                        &        / ( sss_m(ji,jj) + 1.e-20   )
186                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
187                     emp (ji,jj) = emp (ji,jj) + zerp
188                     emps(ji,jj) = emps(ji,jj) + zerp
189                     erp (ji,jj) = zerp
190                  END DO
191               END DO
192               CALL iom_put( "erp", erp )                             ! freshwater flux damping
193            ENDIF
194            !
195         ENDIF
196         !
197      ENDIF
198      !
199   END SUBROUTINE sbc_ssr
200     
201   !!======================================================================
202END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.