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 @ 1200

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)
  • Property svn:keywords set to Id
File size: 9.8 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 sbcrnf          ! surface boundary condition : runoffs
19   USE fldread         ! read input fields
20   USE iom             ! I/O manager
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distribued memory computing library
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   sbc_ssr    ! routine called in sbcmod
29   
30   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   buffer   ! Temporary buffer for exchange
31
32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
34
35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   erp       !: evaporation damping                          [kg/m2/s]
36   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp       !: heat flux damping                            [w/m2]
37
38   !! * Namelist namsbc_ssr
39   INTEGER ::   nn_sstr, nn_sssr   ! SST/SSS indicator
40   REAL(wp) ::  dqdt   , deds      ! restoring term factor
41
42   !! * Substitutions
43#  include "domzgr_substitute.h90"
44   !!----------------------------------------------------------------------
45   !!   OPA 9.0 , LOCEAN-IPSL (2006)
46   !! $Id$
47   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE sbc_ssr( kt )
53      !!---------------------------------------------------------------------
54      !!                     ***  ROUTINE sbc_ssr  ***
55      !!
56      !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term
57      !!                toward observed SST and/or SSS.
58      !!
59      !! ** Method  : - Read namelist namsbc_ssr
60      !!              - Read observed SST and/or SSS
61      !!              - at each nscb time step
62      !!                   add a retroaction term on qns    (nn_sstr = 1)
63      !!                   add a damping term on emps       (nn_sssr = 1)
64      !!                   add a damping term on emp & emps (nn_sssr = 2)
65      !!---------------------------------------------------------------------
66      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
67      !!
68      INTEGER  ::   ji, jj   ! dummy loop indices
69      REAL(wp) ::   zerp     ! local scalar for evaporation damping
70      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
71      REAL(wp) ::   zsrp     ! local scalar for unit conversion of deds factor
72      INTEGER  ::   ierror   ! return error code
73      !!
74      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
75      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
76      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, dqdt, deds, sn_sst, sn_sss
77      !!----------------------------------------------------------------------
78      !                                               ! -------------------- !
79      IF( kt == nit000 ) THEN                         ! First call kt=nit000 !
80         !                                            ! -------------------- !
81         !                         ! set file information
82         nn_sstr = 0
83         nn_sssr = 0
84         dqdt = -40.e0
85         deds = -27.70
86         cn_dir = './'       ! directory in which the model is executed
87         ! ... default values (NB: frequency positive => hours, negative => months)
88         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or !
89         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  !
90         sn_sst = FLD_N( 'sst'    ,    24.    ,  'sst'     ,  .false.   , .false. ,   'yearly'  )
91         sn_sss = FLD_N( 'sss'    ,    -1.    ,  'sss'     ,  .true.    , .false. ,   'yearly'  )
92
93         REWIND ( numnam )         ! ... read in namlist namflx
94         READ( numnam, namsbc_ssr ) 
95
96         IF(lwp) THEN              ! control print
97            WRITE(numout,*)
98            WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
99            WRITE(numout,*) '~~~~~~~ '
100            WRITE(numout,*) '          SST restoring term (Yes=1)             nn_sstr = ', nn_sstr
101            WRITE(numout,*) '          SSS damping term (Yes=1, salt flux)    nn_sssr = ', nn_sssr
102            WRITE(numout,*) '                           (Yes=2, volume flux) '
103            WRITE(numout,*) '          dQ/dT (restoring magnitude on SST)     dqdt    = ', dqdt, ' W/m2/K'
104            WRITE(numout,*) '          dE/dS (restoring magnitude on SST)     deds    = ', deds, ' mm/day'
105         ENDIF
106
107         IF( nn_sstr == 1 ) THEN      ! set sf_sst structure
108            !
109            ALLOCATE( sf_sst(1), STAT=ierror )
110            IF( ierror > 0 ) THEN
111               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
112            ENDIF
113            ALLOCATE( sf_sst(1)%fnow(jpi,jpj) )
114            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) )
115
116            ! fill sf_sst with sn_sst and control print
117            CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
118
119         ENDIF
120         !
121         IF( nn_sssr == 1 ) THEN      ! set sf_sss structure
122            !
123            ALLOCATE( sf_sss(1), STAT=ierror )
124            IF( ierror > 0 ) THEN
125               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
126            ENDIF
127            ALLOCATE( sf_sss(1)%fnow(jpi,jpj) )
128            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) )
129
130            ! fill sf_sss with sn_sss and control print
131            CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
132
133         ENDIF
134         !
135         ! Initialize qrp and erp if no restoring
136         IF( nn_sstr /= 1                   )   qrp(:,:) = 0.e0 
137         IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0 
138      ENDIF
139
140      IF( nn_sstr + nn_sssr /= 0 ) THEN
141
142         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it
143         !                                                          ! at the current time-step
144         IF( nn_sssr == 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it
145         !                                                          ! at the current time-step
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               ! use zqrp scalar to optimize memory access (speedup the loop)
154               DO jj = 1, jpj
155                  DO ji = 1, jpi
156                     zqrp = dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) )
157                     qns(ji,jj) = qns(ji,jj) + zqrp
158                     qrp(ji,jj) = zqrp
159                  END DO
160               END DO
161            ENDIF
162            !
163            IF( nn_sssr == 1 ) THEN                   ! Salinity damping term (salt flux, emps only)
164!CDIR COLLAPSE
165               ! use zerp scalar to optimize memory access (speedup the loop)
166               DO jj = 1, jpj
167                  DO ji = 1, jpi
168                     zsrp = deds / rday                               ! from [mm/day] to [kg/m2/s]
169                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
170                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
171                        &        / ( sss_m(ji,jj) + 1.e-20   )
172                     emps(ji,jj) = emps(ji,jj) + zerp
173                     erp( ji,jj) = zerp
174                  END DO
175               END DO
176            ELSEIF( nn_sssr == 2 ) THEN               ! Salinity damping term (volume flux, emp and emps)
177!CDIR COLLAPSE
178               ! use zerp scalar to optimize memory access (speedup the loop)
179               DO jj = 1, jpj
180                  DO ji = 1, jpi                           
181                     zsrp = deds / rday                               ! from [mm/day] to [kg/m2/s]
182                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
183                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
184                        &        / ( sss_m(ji,jj) + 1.e-20   )
185                     emp (ji,jj) = emp (ji,jj) + zerp
186                     emps(ji,jj) = emps(ji,jj) + zerp
187                     erp (ji,jj) = zerp
188                  END DO
189               END DO
190            ENDIF
191            !
192         ENDIF
193         !
194      ENDIF
195
196      !!gm ... to be written                     ! Output sbc fields (using IOM)
197      ! prevoir comment obtenir l info sst sss ssr
198      !
199   END SUBROUTINE sbc_ssr
200     
201   !!======================================================================
202END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.