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

source: trunk/NEMO/OPA_SRC/SBC/sbcssr.F90 @ 912

Last change on this file since 912 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113
File size: 11.5 KB
Line 
1MODULE sbcssr
2   !!======================================================================
3   !!                       ***  MODULE  sbcssr  ***
4   !! Surface module :  add to heat and fresh water fluxes a restoring term
5   !!                   toward observed SST/SSS
6   !!======================================================================
7   !! History :  9.0   !  06-06  (G. Madec)  Original code
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 daymod          ! calendar
18   USE ocfzpt          ! ocean freezing point
19   USE sbcrnf          ! surface boundary condition : runoffs
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
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   sbc_ssr    ! routine called in sbcmod
30   
31   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   buffer   ! Temporary buffer for exchange
32
33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
34   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
35
36   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   erp       !: evaporation damping                          [kg/m2/s]
37   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp       !: heat flux damping                            [w/m2]
38
39   !! * Namelist namsbc_ssr
40   INTEGER ::   nn_sstr, nn_sssr   ! SST/SSS indicator
41   REAL(wp) ::  dqdt   , deds      ! restoring term factor
42
43   !! * Substitutions
44#  include "domzgr_substitute.h90"
45   !!----------------------------------------------------------------------
46   !!   OPA 9.0 , LOCEAN-IPSL (2006)
47   !! $ Id: $
48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
49   !!----------------------------------------------------------------------
50
51CONTAINS
52
53   SUBROUTINE sbc_ssr( kt )
54      !!---------------------------------------------------------------------
55      !!                     ***  ROUTINE sbc_ssr  ***
56      !!
57      !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term
58      !!                toward observed SST and/or SSS.
59      !!
60      !! ** Method  : - Read namelist namsbc_ssr
61      !!              - Read observed SST and/or SSS
62      !!              - at each nscb time step
63      !!                   add a retroaction term on qns    (nn_sstr = 1)
64      !!                   add a damping term on emps       (nn_sssr = 1)
65      !!                   add a damping term on emp & emps (nn_sssr = 2)
66      !!---------------------------------------------------------------------
67      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
68      !!
69      INTEGER  ::   ji, jj   ! dummy loop indices
70      REAL(wp) ::   zerp     ! local scalar for evaporation damping
71      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
72      REAL(wp) ::   zsrp     ! local scalar for unit conversion of deds factor
73      INTEGER  ::   ierror   ! return error code
74      !!
75      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
76      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
77      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, dqdt, deds, sn_sst, sn_sss
78      !!----------------------------------------------------------------------
79      !                                               ! -------------------- !
80      IF( kt == nit000 ) THEN                         ! First call kt=nit000 !
81         !                                            ! -------------------- !
82         !                         ! set file information
83         nn_sstr = 0
84         nn_sssr = 0
85         dqdt = -40.e0
86         deds = -27.70
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  ! starting !
90         !            !   name    !  (hours)  !   name     !   (T/F)    !  (0/1) !  record  !
91         sn_sst = FLD_N( 'sst'     ,    24.    ,  'sst'     ,  .FALSE.   ,    0   ,     0    )
92         sn_sss = FLD_N( 'sss'     ,   -12.    ,  'sss'     ,  .TRUE.    ,    0   ,     0    )
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,*) '          SST restoring term (Yes=1)             nn_sstr = ', nn_sstr
102            WRITE(numout,*) '          SSS damping term (Yes=1, salt flux)    nn_sssr = ', nn_sssr
103            WRITE(numout,*) '                           (Yes=2, volume flux) '
104            WRITE(numout,*) '          dQ/dT (restoring magnitude on SST)     dqdt    = ', dqdt, ' W/m2/K'
105            WRITE(numout,*) '          dE/dS (restoring magnitude on SST)     deds    = ', deds, ' mm/day'
106         ENDIF
107
108         IF( nn_sstr == 1 ) THEN      ! set sf_sst structure
109            !
110            ALLOCATE( sf_sst(1), STAT=ierror )
111            IF( ierror > 0 ) THEN
112               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
113            ENDIF
114            ! namelist informations stored in sf_sst structures
115            WRITE( sf_sst(1)%clrootname, '(a,a)' )   TRIM( cn_dir ), TRIM( sn_sst%clname )
116            sf_sst(1)%freqh   = sn_sst%freqh
117            sf_sst(1)%clvar   = sn_sst%clvar 
118            sf_sst(1)%ln_tint = sn_sst%ln_tint
119            sf_sst(1)%nclim   = sn_sst%nclim 
120            sf_sst(1)%nstrec  = sn_sst%nstrec 
121            IF(lwp) THEN             ! control print
122               WRITE(numout,*) '   SST restoring term toward SST data in the following file: '
123               WRITE(numout,*) '               root filename: '  , trim( sf_sst(1)%clrootname ),   &
124                  &                          ' variable name: '  , trim( sf_sst(1)%clvar      )
125               WRITE(numout,*) '               frequency: '      ,       sf_sst(1)%freqh       ,   &
126                  &                          ' time interp: '    ,       sf_sst(1)%ln_tint     ,   &
127                  &                          ' climatology: '    ,       sf_sst(1)%nclim       ,   &
128                  &                          ' starting record: ',       sf_sst(1)%nstrec
129            ENDIF
130         ENDIF
131         !
132         IF( nn_sssr == 1 ) THEN      ! set sf_sss structure
133            !
134            ALLOCATE( sf_sss(1), STAT=ierror )
135            IF( ierror > 0 ) THEN
136               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
137            ENDIF
138            ! namelist informations stored in sf_sss structures
139            WRITE( sf_sss(1)%clrootname, '(a,a)' )   TRIM( cn_dir ), TRIM( sn_sss%clname )
140            sf_sss(1)%freqh   = sn_sss%freqh
141            sf_sss(1)%clvar   = sn_sss%clvar
142            sf_sss(1)%ln_tint = sn_sss%ln_tint
143            sf_sss(1)%nclim   = sn_sss%nclim
144            sf_sss(1)%nstrec  = sn_sss%nstrec
145            IF(lwp) THEN             ! control print
146               WRITE(numout,*) '   SSS dampming  term toward SSS data in the following file: ' 
147               WRITE(numout,*) '               root filename: '  , trim( sf_sss(1)%clrootname ),   &
148                  &                          ' variable name: '  , trim( sf_sss(1)%clvar      )
149               WRITE(numout,*) '               frequency: '      ,       sf_sss(1)%freqh       ,   &
150                  &                          ' time interp: '    ,       sf_sss(1)%ln_tint     ,   &
151                  &                          ' climatology: '    ,       sf_sss(1)%nclim       ,   &
152                  &                          ' starting record: ',       sf_sss(1)%nstrec
153            ENDIF
154         ENDIF
155         !
156         ! Initialize qrp and erp if no restoring
157         IF( nn_sstr /= 1                   )   qrp(:,:) = 0.e0 
158         IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0 
159      ENDIF
160
161      IF( nn_sstr + nn_sssr /= 0 ) THEN
162
163         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it
164         !                                                          ! at the current time-step
165         IF( nn_sssr == 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it
166         !                                                          ! at the current time-step
167 
168         !                                         ! ========================= !
169         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
170            !                                      ! ========================= !
171            !
172            IF( nn_sstr == 1 ) THEN                   ! Temperature restoring term
173!CDIR COLLAPSE
174               ! use zqrp scalar to optimize memory access (speedup the loop)
175               DO jj = 1, jpj
176                  DO ji = 1, jpi
177                     zqrp = dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) )
178                     qns(ji,jj) = qns(ji,jj) + zqrp
179                     qrp(ji,jj) = zqrp
180                  END DO
181               END DO
182            ENDIF
183            !
184            IF( nn_sssr == 1 ) THEN                   ! Salinity damping term (salt flux, emps only)
185!CDIR COLLAPSE
186               ! use zerp scalar to optimize memory access (speedup the loop)
187               DO jj = 1, jpj
188                  DO ji = 1, jpi
189                     zsrp = deds / rday                               ! from [mm/day] to [kg/m2/s]
190                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
191                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
192                        &        / ( sss_m(ji,jj) + 1.e-20   )
193                     emps(ji,jj) = emps(ji,jj) + zerp
194                     erp( ji,jj) = zerp
195                  END DO
196               END DO
197            ELSEIF( nn_sssr == 2 ) THEN               ! Salinity damping term (volume flux, emp and emps)
198!CDIR COLLAPSE
199               ! use zerp scalar to optimize memory access (speedup the loop)
200               DO jj = 1, jpj
201                  DO ji = 1, jpi                           
202                     zsrp = deds / rday                               ! from [mm/day] to [kg/m2/s]
203                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
204                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
205                        &        / ( sss_m(ji,jj) + 1.e-20   )
206                     emp (ji,jj) = emp (ji,jj) + zerp
207                     emps(ji,jj) = emps(ji,jj) + zerp
208                     erp (ji,jj) = zerp
209                  END DO
210               END DO
211            ENDIF
212            !
213         ENDIF
214         !
215      ENDIF
216
217      !!gm ... to be written                     ! Output sbc fields (using IOM)
218      ! prevoir comment obtenir l info sst sss ssr
219      !
220   END SUBROUTINE sbc_ssr
221     
222   !!======================================================================
223END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.