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.
sbcclo.F90 in NEMO/trunk/src/OCE/SBC – NEMO

source: NEMO/trunk/src/OCE/SBC/sbcclo.F90 @ 13286

Last change on this file since 13286 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

File size: 16.3 KB
Line 
1MODULE sbcclo
2   !!======================================================================
3   !!                       ***  MODULE  sbcclo  ***
4   !! Ocean forcing: redistribution of emp unbalance over closed sea into river mouth or open ocean
5   !!=====================================================================
6   !! History :  4.0 and earlier ! see closea.F90 history   
7   !!   NEMO     4.1  ! 2019-09  (P. Mathiot) rewrite sbc_clo module to match new closed sea mask definition (original sbcclo.F90)
8   !!
9   !!----------------------------------------------------------------------
10   !
11   !!----------------------------------------------------------------------
12   !!   Public subroutines:
13   !!   sbc_clo       : update emp and qns over target area and source area
14   !!   sbc_clo_init  : initialise all variable needed for closed sea correction
15   !!
16   !!   Private subroutines:
17   !!   alloc_csarr   : allocate closed sea array
18   !!   get_cssrcsurf : compute source surface area
19   !!   get_cstrgsurf : compute target surface area
20   !!   prt_csctl     : closed sea control print
21   !!   sbc_csupdate  : compute net fw from closed sea
22   !!----------------------------------------------------------------------
23   !
24   USE closea                                  ! closed sea
25   USE in_out_manager                          ! I/O manager
26   !
27   USE dom_oce,     ONLY: e1e2t                ! ocean space and time domain
28   USE phycst ,     ONLY: rcp                  ! physical constants
29   USE sbc_oce,     ONLY: emp, qns, rnf, sst_m ! ocean surface boundary conditions
30   USE iom    ,     ONLY: iom_put              ! I/O routines
31   USE lib_fortran, ONLY: glob_sum             ! fortran library
32   USE lib_mpp    , ONLY: mpp_min, ctl_stop    ! MPP library
33   !
34   IMPLICIT NONE
35   !
36   PRIVATE
37   !
38   PUBLIC sbc_clo
39   PUBLIC sbc_clo_init
40   !
41   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg      !: closed sea source/target glo surface areas
42   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr      !: closed sea source/target rnf surface areas
43   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge      !: closed sea source/target emp surface areas
44   !
45   INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)  :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp
46   !
47   CONTAINS
48   !
49   !!----------------------------------------------------------------------
50   !!  Public subroutines
51   !!----------------------------------------------------------------------
52   !
53   SUBROUTINE sbc_clo_init
54      !!---------------------------------------------------------------------
55      !!                  ***  ROUTINE sbc_clo_init  ***
56      !!                   
57      !! ** Purpose :  Initialisation of the variable needed for the net fw closed sea correction
58      !!
59      !! ** Method  :  - compute source surface area for each closed sea
60      !!               - defined the group of each closed sea
61      !!                 (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet)
62      !!               - compute target surface area
63      !!----------------------------------------------------------------------
64      !
65      ! 0. Allocate cs variables (surf)
66      CALL alloc_csarr( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg ) 
67      CALL alloc_csarr( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr )
68      CALL alloc_csarr( ncse, rsurfsrce, rsurftrge, mcsgrpe )
69      !
70      ! 1. compute source surface area
71      CALL get_cssrcsurf( ncsg, mask_csglo, rsurfsrcg )
72      CALL get_cssrcsurf( ncsr, mask_csrnf, rsurfsrcr )
73      CALL get_cssrcsurf( ncse, mask_csemp, rsurfsrce )
74      !
75      ! 2. compute target surface area and group number (mcsgrp) for all cs and cases
76      ! glo could be simpler but for lisibility, all treated the same way
77      ! It is only done once, so not a big deal
78      CALL get_cstrgsurf( ncsg, mask_csglo, mask_csgrpglo, rsurftrgg, mcsgrpg )
79      CALL get_cstrgsurf( ncsr, mask_csrnf, mask_csgrprnf, rsurftrgr, mcsgrpr )
80      CALL get_cstrgsurf( ncse, mask_csemp, mask_csgrpemp, rsurftrge, mcsgrpe )
81      !
82      ! 3. print out in ocean.ouput
83      IF ( lwp ) WRITE(numout,*) 'sbc_clo_init : compute surface area for source (closed sea) and target (river mouth)'
84      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~~~~'
85      CALL prt_csctl( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg, 'glo' )
86      CALL prt_csctl( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr, 'rnf' )
87      CALL prt_csctl( ncse, rsurfsrce, rsurftrge, mcsgrpe, 'emp' )
88
89   END SUBROUTINE sbc_clo_init
90
91   SUBROUTINE sbc_clo( kt )
92      !!---------------------------------------------------------------------
93      !!                  ***  ROUTINE sbc_clo  ***
94      !!                   
95      !! ** Purpose :   Special handling of closed seas
96      !!
97      !! ** Method  :   Water flux is forced to zero over closed sea
98      !!      Excess is shared between remaining ocean, or
99      !!      put as run-off in open ocean.
100      !!
101      !! ** Action  : - compute surface freshwater fluxes and associated heat content flux at kt
102      !!              - output closed sea contribution to fw and heat budget
103      !!              - update emp and qns
104      !!----------------------------------------------------------------------
105      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
106      !
107      REAL(wp), DIMENSION(jpi,jpj) :: zwcs, zqcs    ! water flux and heat flux correction due to closed seas
108      !!----------------------------------------------------------------------
109      !
110      ! 0. initialisation
111      zwcs(:,:) = 0._wp ; zqcs(:,:) = 0._wp
112      !
113      ! 1. update emp and qns
114      CALL sbc_csupdate( ncsg, mcsgrpg, mask_csglo, mask_csgrpglo, rsurfsrcg, rsurftrgg, 'glo', mask_opnsea, rsurftrgg, zwcs, zqcs )
115      CALL sbc_csupdate( ncsr, mcsgrpr, mask_csrnf, mask_csgrprnf, rsurfsrcr, rsurftrgr, 'rnf', mask_opnsea, rsurftrgg, zwcs, zqcs )
116      CALL sbc_csupdate( ncse, mcsgrpe, mask_csemp, mask_csgrpemp, rsurfsrce, rsurftrge, 'emp', mask_opnsea, rsurftrgg, zwcs, zqcs )
117      !
118      ! 2. ouput closed sea contributions
119      CALL iom_put('wclosea',zwcs)
120      CALL iom_put('qclosea',zqcs)
121      !
122      ! 3. update emp and qns
123      emp(:,:) = emp(:,:) + zwcs(:,:)
124      qns(:,:) = qns(:,:) + zqcs(:,:)
125      !
126   END SUBROUTINE sbc_clo
127   !
128   !!----------------------------------------------------------------------
129   !!  Private subroutines
130   !!----------------------------------------------------------------------
131   !
132   SUBROUTINE get_cssrcsurf(kncs, kmaskcs, psurfsrc)
133      !!-----------------------------------------------------------------------
134      !!                  ***  routine get_cssrcsurf  ***
135      !!
136      !! ** Purpose : compute closed sea (source) surface area
137      !!----------------------------------------------------------------------
138      ! subroutine parameters
139      INTEGER ,                 INTENT(in   ) :: kncs          ! closed sea number
140      INTEGER , DIMENSION(:,:), INTENT(in   ) :: kmaskcs       ! closed sea mask
141      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurfsrc      ! source surface area
142
143      ! local variables
144      INTEGER :: jcs                                           ! loop index
145      INTEGER, DIMENSION(jpi,jpj) :: imsksrc                   ! source mask
146      !!----------------------------------------------------------------------
147      !
148      DO jcs = 1,kncs  ! loop over closed seas
149         !
150         ! 0. build river mouth mask for this lake
151         WHERE ( kmaskcs == jcs )
152            imsksrc = 1
153         ELSE WHERE
154            imsksrc = 0
155         END WHERE
156         !
157         ! 1. compute target area
158         psurfsrc(jcs) = glob_sum('closea', e1e2t(:,:) * imsksrc(:,:) )
159         !
160      END DO  ! jcs
161
162   END SUBROUTINE
163
164   SUBROUTINE get_cstrgsurf(kncs, kmaskcs, kmaskcsgrp, psurftrg, kcsgrp )
165      !!-----------------------------------------------------------------------
166      !!                  ***  routine get_cstrgsurf  ***
167      !!
168      !! ** Purpose : compute closed sea (target) surface area
169      !!----------------------------------------------------------------------
170      ! subroutine parameters
171      ! input
172      INTEGER,                 INTENT(in   ) :: kncs                 ! closed sea number
173      INTEGER, DIMENSION(:,:), INTENT(in   ) :: kmaskcs, kmaskcsgrp  ! closed sea and group mask
174
175      ! output
176      INTEGER , DIMENSION(:)  , INTENT(  out) :: kcsgrp              ! closed sea group number
177      REAL(wp), DIMENSION(:)  , INTENT(  out) :: psurftrg            ! target surface area
178
179      ! local variables
180      INTEGER :: jcs, jtmp                                           ! tmp
181      INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg, imsk ! tmp group, source, target and tmp mask
182      !!----------------------------------------------------------------------
183      !
184      DO jcs = 1,kncs  ! loop over closed seas
185         !
186         !! 0. find group number for cs number jcs
187         imskgrp(:,:) = kmaskcsgrp(:,:)
188         imsksrc(:,:) = kmaskcs(:,:)
189         !
190         ! set cs value where cs is defined
191         ! imsk = HUGE outside the cs id jcs
192         imsk(:,:) = HUGE(1)
193         WHERE ( imsksrc(:,:) == jcs ) imsk(:,:) = jcs
194         !
195         ! jtmp = jcs - group id for this lake
196         imsk(:,:) = imsk(:,:) - imskgrp(:,:)
197         jtmp = MINVAL(imsk(:,:)) ; CALL mpp_min('closea',jtmp)
198         ! kcsgrp = group id corresponding to the cs id jcs
199         ! kcsgrp(jcs)=(jcs - (jcs - group id))=group id
200         kcsgrp(jcs) = jcs - jtmp
201         !
202         !! 1. build the target river mouth mask for this lake
203         WHERE ( imskgrp(:,:) * mask_opnsea(:,:) == kcsgrp(jcs) )
204            imsktrg(:,:) = 1
205         ELSE WHERE
206            imsktrg(:,:) = 0
207         END WHERE
208         !
209         !! 2. compute target area
210         psurftrg(jcs) = glob_sum('closea', e1e2t(:,:) * imsktrg(:,:) )
211         !
212      END DO ! jcs
213
214   END SUBROUTINE
215
216   SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, cdcstype)
217      !!-----------------------------------------------------------------------
218      !!                  ***  routine prt_csctl  ***
219      !!
220      !! ** Purpose : output information about each closed sea (src id, trg id, src area and trg area)
221      !!----------------------------------------------------------------------
222      ! subroutine parameters
223      INTEGER,                INTENT(in   ) :: kncs                ! closed sea number               
224      INTEGER, DIMENSION(:) , INTENT(in   ) :: kcsgrp              ! closed sea group number
225      !
226      REAL(wp), DIMENSION(:), INTENT(in   ) :: psurfsrc, psurftrg  ! source and target surface area
227      !
228      CHARACTER(LEN=3)      , INTENT(in   ) :: cdcstype            ! closed sea scheme used for redistribution
229      !!----------------------------------------------------------------------
230      ! local variable
231      INTEGER :: jcs
232      !!----------------------------------------------------------------------
233      !
234      IF ( lwp .AND. kncs > 0 ) THEN
235         WRITE(numout,*)''
236         !
237         WRITE(numout,*)'Closed sea target ',TRIM(cdcstype),' : '
238         !
239         DO jcs = 1,kncs
240            WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg group id is : ', kcsgrp(jcs)
241            WRITE(numout,FMT='(a,f12.2)'   ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6
242            WRITE(numout,FMT='(a,f12.2)'   ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6
243         END DO
244         !
245         WRITE(numout,*)''
246      END IF
247
248   END SUBROUTINE
249
250   SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs)
251      !!-----------------------------------------------------------------------
252      !!                  ***  routine sbc_csupdate  ***
253      !!
254      !! ** Purpose : - compute the net freshwater fluxes over each closed seas
255      !!              - apply correction to closed sea source/target net fwf accordingly
256      !!----------------------------------------------------------------------
257      ! subroutine parameters
258      CHARACTER(LEN=3)        , INTENT(in   ) :: cdcstype  ! closed sea scheme used for redistribution
259      !
260      INTEGER,                 INTENT(in)     :: kncs                                 ! closed sea id
261      INTEGER, DIMENSION(:  ), INTENT(in)     :: kcsgrp                               ! closed sea group id
262      INTEGER, DIMENSION(:,:), INTENT(in)     :: kmsk_src, kmsk_grp, kmsk_opnsea      ! source, target, open ocean mask
263     
264      REAL(wp), DIMENSION(:)  , INTENT(in   ) :: psurfsrc, psurftrg, psurf_opnsea ! source, target and open ocean surface area
265      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pwcs, pqcs                       ! water and heat flux correction due to closed seas
266
267
268      ! local variables
269      INTEGER :: jcs                                     ! loop index over closed sea
270      INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg  ! tmp array source and target closed sea masks
271     
272      REAL(wp) :: zcsfw, zcsh        ! total fresh water and associated heat over one closed sea
273      REAL(wp) :: zcsfwf             ! mean fresh water flux over one closed sea
274      REAL(wp) :: zsurftrg, zsurfsrc ! total target surface area
275      !!----------------------------------------------------------------------
276      !
277      DO jcs = 1, kncs  ! loop over closed seas
278         !
279         !! 0. get mask and surface of the closed sea
280         ! mask src
281         WHERE ( kmsk_src(:,:) == jcs ) 
282            imsk_src(:,:) = 1
283         ELSEWHERE
284            imsk_src(:,:) = 0
285         END WHERE
286         ! area src
287         zsurfsrc = psurfsrc(jcs)
288         !
289         !! 1. Work out net freshwater over the closed sea from EMP - RNF.
290         !!    Work out net heat associated with the correction (needed for conservation)
291         !!    (PM: should we consider used delayed glob sum ?)
292         zcsfw  = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) )
293         !
294         !! 2. Deal with runoff special case (net evaporation spread globally)
295         !!    and compute trg mask
296         IF (cdcstype == 'rnf' .AND. zcsfw  > 0._wp) THEN
297            zsurftrg = psurf_opnsea(1)           ! change the target area surface
298            imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask
299         ELSE
300            zsurftrg = psurftrg(jcs)
301            imsk_trg = kmsk_grp * kmsk_opnsea
302         END IF
303         !
304         !! 3. Subtract residuals from source points
305         zcsfwf = zcsfw / zsurfsrc
306         pwcs(:,:) = pwcs(:,:) -       zcsfwf              * imsk_src(:,:)
307         pqcs(:,:) = pqcs(:,:) + rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:)
308         !
309         !! 4. Add residuals to target points
310         !!    Do not use pqcs(:,:) = pqcs(:,:) - rcp * zcsfw  * sst_m(:,:) / zsurftrg
311         !!    as there is no reason heat will be conserved with this formulation
312         zcsh   = glob_sum( 'closea', e1e2t(:,:) * rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:) )
313         WHERE( imsk_trg(:,:) == kcsgrp(jcs) )
314            pwcs(:,:) = pwcs(:,:) + zcsfw / zsurftrg
315            pqcs(:,:) = pqcs(:,:) - zcsh  / zsurftrg
316         ENDWHERE
317         !
318      END DO ! jcs
319
320   END SUBROUTINE
321
322   SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp )
323      !!-----------------------------------------------------------------------
324      !!                  ***  routine alloc_cssurf  ***
325      !!
326      !! ** Purpose : allocate closed sea surface array
327      !!----------------------------------------------------------------------
328      ! subroutine parameters
329      INTEGER,  INTENT(in) :: klen
330      INTEGER,  ALLOCATABLE, DIMENSION(:), INTENT(  out) :: kvargrp
331      REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(  out) :: pvarsrc, pvartrg 
332      !
333      ! local variables
334      INTEGER :: ierr
335      !!----------------------------------------------------------------------
336      !
337      ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array
338      ALLOCATE( pvarsrc(MAX(klen,1)) , pvartrg(MAX(klen,1)) , STAT=ierr )
339      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
340      !
341      ALLOCATE( kvargrp(MAX(klen,1)) , STAT=ierr )
342      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array')
343      !
344      ! initialise to 0
345      pvarsrc(:) = 0.e0_wp
346      pvartrg(:) = 0.e0_wp
347      kvargrp(:) = 0
348   END SUBROUTINE
349
350END MODULE
Note: See TracBrowser for help on using the repository browser.