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

Last change on this file since 713 was 713, checked in by smasson, 17 years ago

reintroduce qrp and erp, see ticket:10
  • Property svn:executable set to *
File size: 11.0 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   !! * Namelist namsbc_ssr
37   INTEGER ::   nn_sst, nn_sss   ! SST/SSS indicator
38   REAL(wp) ::  dqdt  , deds     ! restoring term factor
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !!   OPA 9.0 , LOCEAN-IPSL (2006)
44   !! $Header: $
45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE sbc_ssr( kt )
51      !!---------------------------------------------------------------------
52      !!                     ***  ROUTINE sbc_ssr  ***
53      !!
54      !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term
55      !!                toward observed SST and/or SSS.
56      !!
57      !! ** Method  : - Read namelist namsbc_ssr
58      !!              - Read observed SST and/or SSS
59      !!              - at each nscb time step
60      !!                   add a retroaction term on qns    (nn_sst = 1)
61      !!                   add a damping term on emps       (nn_sss = 1)
62      !!                   add a damping term on emp & emps (nn_sss = 2)
63      !!---------------------------------------------------------------------
64      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
65      !!
66      INTEGER  ::   ji, jj   ! dummy loop indices
67      REAL(wp) ::   zerp     ! local scalar for evaporation damping
68      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
69      INTEGER  ::   ierror   ! return error code
70      !!
71      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
72      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
73      NAMELIST/namsbc_ssr/ cn_dir, nn_sst, nn_sss, dqdt, deds, sn_sst, sn_sss
74      !!----------------------------------------------------------------------
75      !                                               ! -------------------- !
76      IF( kt == nit000 ) THEN                         ! First call kt=nit000 !
77         !                                            ! -------------------- !
78         !                         ! set file information
79         nn_sst = 0
80         nn_sss = 0
81         dqdt = -40.e0
82         deds = -40.e0
83         cn_dir = './'       ! directory in which the model is executed
84         ! ... default values (NB: frequency positive => hours, negative => months)
85         !            !   file    ! frequency !  variable  ! time intep !  clim  ! starting !
86         !            !   name    !  (hours)  !   name     !   (T/F)    !  (0/1) !  record  !
87         sn_sst = FLD_N( 'sst'     ,    24.    ,  'sst'     ,  .FALSE.   ,    0   ,     0    )
88         sn_sss = FLD_N( 'sss'     ,   -12.    ,  'sss'     ,  .TRUE.    ,    0   ,     0    )
89
90         REWIND ( numnam )         ! ... read in namlist namflx
91         READ( numnam, namsbc_ssr ) 
92
93         IF(lwp) THEN              ! control print
94            WRITE(numout,*)
95            WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
96            WRITE(numout,*) '~~~~~~~ '
97            WRITE(numout,*) '          SST restoring term (Yes=1)             nn_sst = ', nn_sst
98            WRITE(numout,*) '          SSS damping term (Yes=1, salt flux)    nn_sss = ', nn_sss
99            WRITE(numout,*) '                           (Yes=2, volume flux) '
100            WRITE(numout,*) '          dQ/dT (restoring magnitude on SST)     dqdt     = ', dqdt, ' W/m2/K'
101            WRITE(numout,*) '          dE/dS (restoring magnitude on SST)     deds     = ', deds, ' ???'
102         ENDIF
103
104         IF( nn_sst == 1 ) THEN      ! set sf_sst structure
105            !
106            ALLOCATE( sf_sst(1), STAT=ierror )
107            IF( ierror > 0 ) THEN
108               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
109            ENDIF
110            ! namelist informations stored in sf_sst structures
111            WRITE( sf_sst(1)%clrootname, '(a,a)' )   TRIM( cn_dir ), TRIM( sn_sst%clname )
112            sf_sst(1)%freqh   = sn_sst%freqh
113            sf_sst(1)%clvar   = sn_sst%clvar 
114            sf_sst(1)%ln_tint = sn_sst%ln_tint
115            sf_sst(1)%nclim   = sn_sst%nclim 
116            sf_sst(1)%nstrec  = sn_sst%nstrec 
117            IF(lwp) THEN             ! control print
118               WRITE(numout,*) '   SST restoring term toward SST data in the following file: '
119               WRITE(numout,*) '               root filename: '  , trim( sf_sst(1)%clrootname ),   &
120                  &                          ' variable name: '  , trim( sf_sst(1)%clvar      )
121               WRITE(numout,*) '               frequency: '      ,       sf_sst(1)%freqh       ,   &
122                  &                          ' time interp: '    ,       sf_sst(1)%ln_tint     ,   &
123                  &                          ' climatology: '    ,       sf_sst(1)%nclim       ,   &
124                  &                          ' starting record: ',       sf_sst(1)%nstrec
125            ENDIF
126         ENDIF
127         !
128         IF( nn_sss == 1 ) THEN      ! set sf_sss structure
129            !
130            ALLOCATE( sf_sss(1), STAT=ierror )
131            IF( ierror > 0 ) THEN
132               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
133            ENDIF
134            ! namelist informations stored in sf_sss structures
135            WRITE( sf_sss(1)%clrootname, '(a,a)' )   TRIM( cn_dir ), TRIM( sn_sss%clname )
136            sf_sss(1)%freqh   = sn_sss%freqh
137            sf_sss(1)%clvar   = sn_sss%clvar
138            sf_sss(1)%ln_tint = sn_sss%ln_tint
139            sf_sss(1)%nclim   = sn_sss%nclim
140            sf_sss(1)%nstrec  = sn_sss%nstrec
141            IF(lwp) THEN             ! control print
142               WRITE(numout,*) '   SSS dampming  term toward SSS data in the following file: ' 
143               WRITE(numout,*) '               root filename: '  , trim( sf_sss(1)%clrootname ),   &
144                  &                          ' variable name: '  , trim( sf_sss(1)%clvar      )
145               WRITE(numout,*) '               frequency: '      ,       sf_sss(1)%freqh       ,   &
146                  &                          ' time interp: '    ,       sf_sss(1)%ln_tint     ,   &
147                  &                          ' climatology: '    ,       sf_sss(1)%nclim       ,   &
148                  &                          ' starting record: ',       sf_sss(1)%nstrec
149            ENDIF
150         ENDIF
151         !
152         ! Initialize qrp and erp if no restoring
153         IF( nn_sst /= 1                  )   qrp(:,:) = 0.e0 
154         IF( nn_sss /= 1 .OR. nn_sss /= 2 )   erp(:,:) = 0.e0 
155      ENDIF
156
157      IF( nn_sst + nn_sss /= 0 ) THEN
158
159         IF( nn_sst == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it
160         !                                                         ! at the current time-step
161         IF( nn_sss == 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it
162         !                                                         ! at the current time-step
163 
164         !                                         ! ========================= !
165         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
166            !                                      ! ========================= !
167            !
168            IF( nn_sst == 1 ) THEN                   ! Temperature restoring term
169!CDIR COLLAPSE
170               ! use zqrp scalar to optimize memory access (speedup the loop)
171               DO jj = 1, jpj
172                  DO ji = 1, jpi
173                     zqrp = dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) )
174                     qns(ji,jj) = qns(ji,jj) + zqrp
175                     qrp(ji,jj) = zqrp
176                  END DO
177               END DO
178            ENDIF
179            !
180            IF( nn_sss == 1 ) THEN                   ! Salinity damping term (salt   flux, emps only)
181!CDIR COLLAPSE
182               ! use zerp scalar to optimize memory access (speedup the loop)
183               DO jj = 1, jpj
184                  DO ji = 1, jpi
185                     zerp = deds * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vivinity of river mouths
186                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
187                        &        / ( sss_m(ji,jj) + 1.e-20   )
188                     emps(ji,jj) = emps(ji,jj) + zerp
189                     erp( ji,jj) = zerp
190                  END DO
191               END DO
192            ELSEIF( nn_sss == 2 ) THEN               ! Salinity damping term (volume flux, emp and emps)
193!CDIR COLLAPSE
194               ! use zerp scalar to optimize memory access (speedup the loop)
195               DO jj = 1, jpj
196                  DO ji = 1, jpi                           
197                     zerp = deds * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vivinity of river mouths
198                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
199                        &        / ( sss_m(ji,jj) + 1.e-20   )
200                     emp (ji,jj) = emp (ji,jj) + zerp
201                     emps(ji,jj) = emps(ji,jj) + zerp
202                     erp (ji,jj) = zerp
203                  END DO
204               END DO
205            ENDIF
206            !
207         ENDIF
208         !
209      ENDIF
210
211      !!gm ... to be written                     ! Output sbc fields (using IOM)
212      ! prevoir comment obtenir l info sst sss ssr
213      !
214   END SUBROUTINE sbc_ssr
215     
216   !!======================================================================
217END MODULE sbcssr
Note: See TracBrowser for help on using the repository browser.