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.
sbcflx_adj.F90 in branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx_adj.F90 @ 5895

Last change on this file since 5895 was 5895, checked in by kuniko, 8 years ago

Made treatment of river mouth grids consistent in nn_flxadjfw 1&2.
File size: 11.5 KB
Line 
1MODULE sbcflx_adj
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx_adj  ***
4   !! Surface module :  flux adjustment of heat/freshwater. Add qrp/erp obtained from sbcssr
5   !!======================================================================
6   !! History :  0.0  !  2015-10-14  (K. Yamazaki)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   sbc_flx_adj       : add qrp/erp to sbc to perform flux adjustment
11   !!   sbc_flx_adj_init  : initialisation of flux adjustment
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   !
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   USE timing         ! Timing
25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   sbc_flx_adj        ! routine called in sbcmod
31   PUBLIC   sbc_flx_adj_init   ! routine called in sbcmod
32
33   !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s]
34   !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2]
35
36   !                                   !!* Namelist namsbc_flx_adj *
37   INTEGER, PUBLIC ::   nn_flxadjht     ! Heat/freshwater flux adjustment indicator
38   INTEGER, PUBLIC ::   nn_flxadjfw     ! Heat/freshwater flux adjustment indicator
39   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term
40   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
41
42   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
43   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_erp   ! structure of input erp (file informations, fields read)
44   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qrp   ! structure of input qrp (file informations, fields read)
45
46   !! * Substitutions
47#  include "domzgr_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
50   !! $Id: sbcssr.F90 4990 2014-12-15 16:42:49Z timgraham $
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE sbc_flx_adj( kt )
56      !!---------------------------------------------------------------------
57      !!                     ***  ROUTINE sbc_flx_adj  ***
58      !!
59      !! ** Purpose :   Add to heat and/or freshwater fluxes a qrp and/or erp
60      !!                to flux adjust temperature/salinity
61      !!
62      !! ** Method  : - Read namelist namsbc_flx_adj
63      !!              - Read calculated qrp and/or erp
64      !!              - at each nscb time step
65      !!                   add qrp on qns    (nn_flxadjht = 1)
66      !!                   add erp on sfx        (nn_flxadjfw = 1)
67      !!                   add erp on emp        (nn_flxadjfw = 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) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
75      INTEGER  ::   ierror   ! return error code
76      !!
77      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
78      TYPE(FLD_N) ::   sn_qrp, sn_erp        ! informations about the fields to be read
79      !!----------------------------------------------------------------------
80      !
81      IF( nn_timing == 1 )  CALL timing_start('sbc_flx_adj')
82      !
83      IF( nn_flxadjht + nn_flxadjfw /= 0 ) THEN
84         !
85         IF( nn_flxadjht == 1)   CALL fld_read( kt, nn_fsbc, sf_qrp )   ! Read qrp data and provides it at kt
86         IF( nn_flxadjfw >= 1)   CALL fld_read( kt, nn_fsbc, sf_erp )   ! Read erp data and provides it at kt
87         !
88         !                                         ! ========================= !
89         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
90            !                                      ! ========================= !
91            !
92            IF( nn_flxadjht == 1 ) THEN                                   !* Anomalous heat flux term (qrp)
93               DO jj = 1, jpj
94                  DO ji = 1, jpi
95                     zqrp = sf_qrp(1)%fnow(ji,jj,1)
96                     qns(ji,jj) = qns(ji,jj) + zqrp
97                  END DO
98               END DO
99            !ky!   CALL iom_put( "qrp", qrp )                             ! heat flux damping
100            ENDIF
101            !
102            IF( nn_flxadjfw == 1 ) THEN                               !* Anomalous freshwater term !(salt flux only (sfx))
103!CDIR COLLAPSE
104               DO jj = 1, jpj
105                  DO ji = 1, jpi
106                     zerp = ( 1. - 2.*rnfmsk(ji,jj) )  &              ! No damping in vicinity of river mouths
107                        &        * sf_erp(1)%fnow(ji,jj,1)
108                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
109                  END DO
110               END DO
111               !ky!CALL iom_put( "erp", erp )                             ! freshwater flux damping
112               !
113            ELSEIF( nn_flxadjfw == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
114               zerp_bnd = rn_sssr_bnd / rday                          !       -              -   
115!CDIR COLLAPSE
116               DO jj = 1, jpj
117                  DO ji = 1, jpi                           
118                     zerp = ( 1. - 2.*rnfmsk(ji,jj) )  &              ! No damping in vicinity of river mouths
119                        &        * sf_erp(1)%fnow(ji,jj,1)
120                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
121                     emp(ji,jj) = emp (ji,jj) + zerp
122                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
123                  END DO
124               END DO
125               !ky!CALL iom_put( "erp", erp )                             ! freshwater flux damping
126            ENDIF
127            !
128         ENDIF
129         !
130      ENDIF
131      !
132      IF( nn_timing == 1 )  CALL timing_stop('sbc_flx_adj')
133      !
134   END SUBROUTINE sbc_flx_adj
135
136 
137   SUBROUTINE sbc_flx_adj_init
138      !!---------------------------------------------------------------------
139      !!                  ***  ROUTINE sbc_flx_adj_init  ***
140      !!
141      !! ** Purpose :   initialisation of surface damping term
142      !!
143      !! ** Method  : - Read namelist namsbc_flx_adj
144      !ky!!!              - Read observed SST and/or SSS if required
145      !!---------------------------------------------------------------------
146      INTEGER  ::   ji, jj   ! dummy loop indices
147      REAL(wp) ::   zerp     ! local scalar for evaporation damping
148      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
149      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
150      INTEGER  ::   ierror   ! return error code
151      !!
152      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
153      TYPE(FLD_N) ::   sn_qrp, sn_erp        ! informations about the fields to be read
154      NAMELIST/namsbc_flx_adj/ cn_dir, nn_flxadjht, nn_flxadjfw, sn_qrp, sn_erp,   &
155         &                     ln_sssr_bnd, rn_sssr_bnd
156      INTEGER     ::  ios
157      !!----------------------------------------------------------------------
158      !
159 
160      REWIND( numnam_ref )              ! Namelist namsbc_flx_adj in reference namelist :
161      READ  ( numnam_ref, namsbc_flx_adj, IOSTAT = ios, ERR = 901)
162901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in reference namelist', lwp )
163
164      REWIND( numnam_cfg )              ! Namelist namsbc_flx_adj in configuration namelist :
165      READ  ( numnam_cfg, namsbc_flx_adj, IOSTAT = ios, ERR = 902 )
166902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in configuration namelist', lwp )
167      IF(lwm) WRITE ( numond, namsbc_flx_adj )
168
169      IF(lwp) THEN                 !* control print
170         WRITE(numout,*)
171         WRITE(numout,*) 'sbc_flx_adj : Heat and/or freshwater flux adjustment term '
172         WRITE(numout,*) '~~~~~~~ '
173         WRITE(numout,*) '   Namelist namsbc_flx_adj :'
174         WRITE(numout,*) '      Anom. heat flux (qrp) term (Yes=1)             nn_flxadjht     = ', nn_flxadjht
175         WRITE(numout,*) '      Anom. fw flux (erp) term (Yes=1, salt flux)    nn_flxadjfw     = ', nn_flxadjfw
176         WRITE(numout,*) '                                           (Yes=2, volume flux) '
177         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
178         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
179      ENDIF
180      !
181      !                            !* Allocate erp and qrp array
182      !ky!ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
183      !ky!IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
184      !
185      IF( nn_flxadjht == 1 ) THEN      !* set sf_qrp structure & allocate arrays
186         !
187         ALLOCATE( sf_qrp(1), STAT=ierror )
188         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp structure' )
189         ALLOCATE( sf_qrp(1)%fnow(jpi,jpj,1), STAT=ierror )
190         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp now array' )
191         !
192         ! fill sf_qrp with sn_qrp and control print
193         CALL fld_fill( sf_qrp, (/ sn_qrp /), cn_dir, 'sbc_qrp', 'Heat flux adjustment', 'namsbc_flx_adj' )
194         IF( sf_qrp(1)%ln_tint )   ALLOCATE( sf_qrp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
195         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp data array' )
196         !
197      ENDIF
198      !
199      IF( nn_flxadjfw >= 1 ) THEN      !* set sf_erp structure & allocate arrays
200         !
201         ALLOCATE( sf_erp(1), STAT=ierror )
202         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp structure' )
203         ALLOCATE( sf_erp(1)%fnow(jpi,jpj,1), STAT=ierror )
204         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp now array' )
205         !
206         ! fill sf_erp with sn_erp and control print
207         CALL fld_fill( sf_erp, (/ sn_erp /), cn_dir, 'sbc_erp', 'Freshwater flux adjustment term', 'namsbc_flx_adj' )
208         IF( sf_erp(1)%ln_tint )   ALLOCATE( sf_erp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
209         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp data array' )
210         !
211      ENDIF
212      !
213      !ky!!                            !* Initialize qrp and erp if no restoring
214      !ky!IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
215      !ky!IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
216      !
217   END SUBROUTINE sbc_flx_adj_init
218     
219   !!======================================================================
220END MODULE sbcflx_adj
Note: See TracBrowser for help on using the repository browser.