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.
closea.f90 in branches/UKMO/dev_r8600_nn_etau_options/NEMOGCM/TOOLS/DOMAINcfg/src – NEMO

source: branches/UKMO/dev_r8600_nn_etau_options/NEMOGCM/TOOLS/DOMAINcfg/src/closea.f90 @ 8875

Last change on this file since 8875 was 8875, checked in by davestorkey, 6 years ago

UKMO/dev_r8600_nn_etau_options branch: remove SVN keywords.

File size: 11.1 KB
Line 
1MODULE closea
2   !!======================================================================
3   !!                       ***  MODULE  closea  ***
4   !! Closed Seas  : specific treatments associated with closed seas
5   !!======================================================================
6   !! History :   8.2  !  00-05  (O. Marti)  Original code
7   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90
8   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
9   !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   dom_clo    : modification of the ocean domain for closed seas cases
14   !!   sbc_clo    : Special handling of closed seas
15   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
16   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
17   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
18   !!----------------------------------------------------------------------
19   USE oce             ! dynamics and tracers
20   USE dom_oce         ! ocean space and time domain
21   USE phycst          ! physical constants
22   USE in_out_manager  ! I/O manager
23   USE lib_fortran,    ONLY: glob_sum, DDPDD
24   USE lbclnk          ! lateral boundary condition - MPP exchanges
25   USE lib_mpp         ! MPP library
26   USE timing
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC dom_clo      ! routine called by domain module
32   PUBLIC clo_bat      ! routine called in domzgr module
33
34   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea
35   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
36   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
37   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
38   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
39   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
40
41   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
42
43   !! * Substitutions
44   !!----------------------------------------------------------------------
45   !!                   ***  vectopt_loop_substitute  ***
46   !!----------------------------------------------------------------------
47   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
48   !!                allow unrolling of do-loop (useful with vector processors)
49   !!----------------------------------------------------------------------
50   !!----------------------------------------------------------------------
51   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
52   !! $Id$
53   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55   !!----------------------------------------------------------------------
56   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
57   !! $Id$
58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
59   !!----------------------------------------------------------------------
60CONTAINS
61
62   SUBROUTINE dom_clo
63      !!---------------------------------------------------------------------
64      !!                  ***  ROUTINE dom_clo  ***
65      !!       
66      !! ** Purpose :   Closed sea domain initialization
67      !!
68      !! ** Method  :   if a closed sea is located only in a model grid point
69      !!                just the thermodynamic processes are applied.
70      !!
71      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
72      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
73      !!                ncsir(), ncsjr() : Location of runoff
74      !!                ncsnr            : number of point where run-off pours
75      !!                ncstt            : Type of closed sea
76      !!                                   =0 spread over the world ocean
77      !!                                   =2 put at location runoff
78      !!----------------------------------------------------------------------
79      INTEGER ::   jc      ! dummy loop indices
80      INTEGER ::   isrow   ! local index
81      !!----------------------------------------------------------------------
82      !
83      IF(lwp) WRITE(numout,*)
84      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
85      IF(lwp) WRITE(numout,*)'~~~~~~~'
86      !
87      ! initial values
88      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
89      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
90      !
91      ! set the closed seas (in data domain indices)
92      ! -------------------
93      !
94      IF( cp_cfg == "orca" ) THEN
95         !
96         SELECT CASE ( jp_cfg )
97         !                                           ! =======================
98         CASE ( 1 )                                  ! ORCA_R1 configuration
99            !                                        ! =======================
100            ! This dirty section will be suppressed by simplification process:
101            ! all this will come back in input files
102            ! Currently these hard-wired indices relate to configuration with
103            ! extend grid (jpjglo=332)
104            isrow = 332 - jpjglo
105            !
106            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
107            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
108            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
109            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
110            !                                       
111            !                                        ! =======================
112         CASE ( 2 )                                  !  ORCA_R2 configuration
113            !                                        ! =======================
114            !                                            ! Caspian Sea
115            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
116            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
117            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
118            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
119            !                                            ! Great North American Lakes
120            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
121            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
122            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
123            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
124            !                                            ! Black Sea (crossed by the cyclic boundary condition)
125            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
126            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
127            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
128            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
129            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
130            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea     
131            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
132            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea
133            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
134             
135         
136
137            !                                        ! =======================
138         CASE ( 4 )                                  !  ORCA_R4 configuration
139            !                                        ! =======================
140            !                                            ! Caspian Sea
141            ncsnr(1)   =  1  ;  ncstt(1)   =  0 
142            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
143            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
144            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
145            !                                            ! Great North American Lakes
146            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
147            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
148            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
149            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
150            !                                            ! Black Sea
151            ncsnr(3)   =  4  ;  ncstt(3)   =  2 
152            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
153            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
154            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
155            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
156            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
157            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
158            !                                            ! Baltic Sea
159            ncsnr(4)   =  1  ;  ncstt(4)   =  2
160            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
161            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
162            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
163            !                                        ! =======================
164         CASE ( 025 )                                ! ORCA_R025 configuration
165            !                                        ! =======================
166            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
167            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
168            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
169            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
170            !                                       
171            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea
172            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
173            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
174            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
175            !
176         END SELECT
177         !
178      ENDIF
179
180      ! convert the position in local domain indices
181      ! --------------------------------------------
182      DO jc = 1, jpncs
183         ncsi1(jc)   = mi0( ncsi1(jc) )
184         ncsj1(jc)   = mj0( ncsj1(jc) )
185
186         ncsi2(jc)   = mi1( ncsi2(jc) )   
187         ncsj2(jc)   = mj1( ncsj2(jc) ) 
188      END DO
189      !
190   END SUBROUTINE dom_clo
191
192
193   SUBROUTINE clo_bat( pbat, kbat )
194      !!---------------------------------------------------------------------
195      !!                  ***  ROUTINE clo_bat  ***
196      !!                   
197      !! ** Purpose :   suppress closed sea from the domain
198      !!
199      !! ** Method  :   set to 0 the meter and level bathymetry (given in
200      !!                arguments) over the closed seas.
201      !!
202      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
203      !!----------------------------------------------------------------------
204      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
205      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
206      !
207      INTEGER  ::   jc, ji, jj      ! dummy loop indices
208      !!----------------------------------------------------------------------
209      !
210      DO jc = 1, jpncs
211         DO jj = ncsj1(jc), ncsj2(jc)
212            DO ji = ncsi1(jc), ncsi2(jc)
213               pbat(ji,jj) = 0._wp   
214               kbat(ji,jj) = 0   
215            END DO
216         END DO
217       END DO 
218       !
219   END SUBROUTINE clo_bat
220
221   !!======================================================================
222END MODULE closea
223
Note: See TracBrowser for help on using the repository browser.