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.
domcfg.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90 @ 4400

Last change on this file since 4400 was 3837, checked in by trackstand2, 11 years ago

Merge of finiss
  • Property svn:keywords set to Id
File size: 11.6 KB
Line 
1MODULE domcfg
2   !!==============================================================================
3   !!                       ***  MODULE domcfg   ***
4   !! Ocean initialization : domain configuration initialization
5   !!==============================================================================
6   !! History :  1.0  ! 2003-09  (G. Madec)  Original code
7   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   dom_cfg        : initialize the domain configuration
12   !!----------------------------------------------------------------------
13   USE dom_oce         ! ocean space and time domain
14   USE phycst          ! physical constants
15   USE in_out_manager  ! I/O manager
16   USE lib_mpp         ! distributed memory computing library
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   dom_cfg    ! called by opa.F90
22
23   !! * Control permutation of array indices
24#  include "dom_oce_ftrans.h90"
25
26   !!----------------------------------------------------------------------
27   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
28   !! $Id$
29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE dom_cfg
34      !!----------------------------------------------------------------------
35      !!                  ***  ROUTINE dom_cfg  ***
36      !!                   
37      !! ** Purpose :   set the domain configuration
38      !!
39      !!----------------------------------------------------------------------
40
41      IF(lwp) THEN                   ! Control print
42         WRITE(numout,*)
43         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
44         WRITE(numout,*) '~~~~~~~ '
45         WRITE(numout,*) '   ocean model configuration used :   cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
46         !
47         WRITE(numout,*) '   global domain lateral boundaries'
48         !
49         IF( jperio == 0 )   WRITE(numout,*) '      jperio= 0, closed'
50         IF( jperio == 1 )   WRITE(numout,*) '      jperio= 1, cyclic east-west'
51         IF( jperio == 2 )   WRITE(numout,*) '      jperio= 2, equatorial symmetric'
52         IF( jperio == 3 )   WRITE(numout,*) '      jperio= 3, north fold with T-point pivot'
53         IF( jperio == 4 )   WRITE(numout,*) '      jperio= 4, cyclic east-west and north fold with T-point pivot'
54         IF( jperio == 5 )   WRITE(numout,*) '      jperio= 5, north fold with F-point pivot'
55         IF( jperio == 6 )   WRITE(numout,*) '      jperio= 6, cyclic east-west and north fold with F-point pivot'
56      ENDIF
57      !
58      IF( jperio <  0 .OR. jperio > 6 )   CALL ctl_stop( 'jperio is out of range' )
59      !
60      CALL dom_glo                   ! global domain versus zoom and/or local domain
61      !
62   END SUBROUTINE dom_cfg
63
64
65   SUBROUTINE dom_glo
66      !!----------------------------------------------------------------------
67      !!                     ***  ROUTINE dom_glo  ***
68      !!
69      !! ** Purpose :   initialization for global domain, zoom and local domain
70      !!
71      !! ** Method  :   
72      !!
73      !! ** Action  : - mig  , mjg :
74      !!              - mi0  , mi1   :
75      !!              - mj0, , mj1   :
76      !!----------------------------------------------------------------------
77      USE mapcomm_mod, Only: iesub, jesub
78      !! * Local declarations
79      INTEGER ::   ji, jj   ! dummy loop argument
80      !!----------------------------------------------------------------------
81
82      !                        ! ============== !
83      !                        !  Local domain  !
84      !                        ! ============== !
85!!$#if defined key_mpp_rkpart
86!!$      WRITE(*,*) 'ARPDBG: ',narea,': dom_glo: nld{i,j} = ',nldi,nldj
87!!$      WRITE(*,*) 'ARPDBG: ',narea,': dom_glo: nlc{i,j} = ',nlci,nlcj
88!!$      WRITE(*,*) 'ARPDBG: ',narea,': dom_glo: jp{i,j} = ',jpi,jpj
89!!$      WRITE(*,*) 'ARPDBG: ',narea,': dom_glo: n{i,j}mpp = ',nimpp, njmpp
90!!$      WRITE(*,*) 'ARPDBG: ',narea,': dom_glo: jp{i,j}zoom = ',jpizoom, jpjzoom
91!!$      DO ji = 1, jpi, 1
92!!$        mig(ji) = ji - nldi + jpizoom - 1 + nimpp - 1
93!!$!        WRITE(*,FMT="('ARPDBG, mig(',I3,') = ',I3)") &
94!!$!              ji, mig(ji)
95!!$      END DO
96!!$      DO jj = 1, jpj, 1
97!!$        mjg(jj) = jj - nldj + jpjzoom - 1 + njmpp - 1
98!!$!        WRITE(*,FMT="('ARPDBG, mjg(',I3,') = ',I3)") &
99!!$!              jj, mjg(jj)
100!!$      END DO
101!!$#else
102      DO ji = 1, jpi                 ! local domain indices ==> data domain indices
103        mig(ji) = ji + jpizoom - 1 + nimpp - 1
104      END DO
105      DO jj = 1, jpj
106        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
107      END DO
108!!$#endif
109      !
110      !                              ! data domain indices ==> local domain indices
111      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
112      !                                   !local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
113#if 0
114!defined key_mpp_rkpart
115      mi0(1:nimpp-1) = 1 !nldi
116      DO ji = 0,iesub-1,1
117         mi0(nimpp+ji) = nldi + ji
118      END DO
119      ! Halo columns (if any)
120      IF(nimpp+iesub <= jpidta)   mi0(nimpp+iesub) = jpi+1
121      IF(nimpp+iesub+1 <= jpidta) mi0(nimpp+iesub+1:)=jpi+1
122
123      mi1(1:nimpp-2) = 0
124      IF(nimpp > 1)mi1(nimpp - 1) = 0
125      DO ji = 0,iesub-1,1
126         mi1(nimpp+ji) = nldi + ji
127      END DO
128      ! Halo columns (if any)
129      IF(nimpp+iesub <= jpidta)   mi1(nimpp+iesub)   = jpi
130      IF(nimpp+iesub+1 <= jpidta) mi1(nimpp+iesub+1:)= jpi
131
132      mj0(:njmpp-1) = 1 ! nldj
133      DO jj = 0,jesub-1,1
134         mj0(njmpp+jj) = nldj + jj
135      END DO
136      ! Halo rows (if any)
137      IF(njmpp+jesub <= jpjdta)   mj0(njmpp+jesub) = jpj+1
138      IF(njmpp+jesub+1 <= jpjdta) mj0(njmpp+jesub+1:)=jpj+1
139
140      mj1(1:njmpp-2) = 0
141      IF(njmpp > 1)mj1(njmpp - 1) = 0
142      DO jj = 0,jesub-1,1
143         mj1(njmpp+jj) = nldj + jj
144      END DO
145      ! Halo rows (if any)
146      IF(njmpp+jesub <= jpjdta)   mj1(njmpp+jesub)   = jpj
147      IF(njmpp+jesub+1 <= jpjdta) mj1(njmpp+jesub+1:)= jpj
148#else
149      DO ji = 1, jpidta
150        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
151        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
152      END DO
153      DO jj = 1, jpjdta
154        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
155        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
156      END DO
157#endif
158
159      IF(lwp) THEN                   ! control print
160         WRITE(numout,*)
161         WRITE(numout,*) 'dom_glo : domain: data / local '
162         WRITE(numout,*) '~~~~~~~ '
163         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
164            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
165         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
166            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
167         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
168            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
169         WRITE(numout,*)
170         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
171            &                                           ' jpjzoom = ', jpjzoom
172         WRITE(numout,*)
173         WRITE(numout,*) '          conversion local  ==> data i-index domain'
174         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
175         WRITE(numout,*)
176         WRITE(numout,*) '          conversion data   ==> local  i-index domain'
177         WRITE(numout,*) '             starting index'
178         WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
179         WRITE(numout,*) '             ending index'
180         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
181         WRITE(numout,*)
182         WRITE(numout,*) '          conversion local  ==> data j-index domain'
183         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
184         WRITE(numout,*)
185         WRITE(numout,*) '          conversion data  ==> local j-index domain'
186         WRITE(numout,*) '             starting index'
187         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
188         WRITE(numout,*) '             ending index'
189         WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
190      ENDIF
191 25   FORMAT( 100(10x,19i4,/) )
192
193      !                        ! ============== !
194      !                        !  Zoom domain   !
195      !                        ! ============== !
196      !                              ! zoom control
197      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
198          jpjglo + jpjzoom - 1  >  jpjdta      ) &
199          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )
200
201      !                              ! set zoom flag
202      IF( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
203
204      !                              ! set zoom type flags
205      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     !
206      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
207      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
208      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
209
210      IF(lwp) THEN
211         WRITE(numout,*)
212         WRITE(numout,*) '          zoom flags : '
213         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
214         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
215         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
216         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
217         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
218      ENDIF
219      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   &
220           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )
221      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   &
222           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )
223
224      !                              ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
225      IF( cp_cfg == "orca" ) THEN
226         SELECT CASE ( jp_cfg )
227         CASE ( 2 )                               !  ORCA_R2 configuration
228            IF(  jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
229               & jpizoom ==  21    .AND. jpjzoom ==  97         )   lzoom_arct = .TRUE.
230            IF(  jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
231               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
232            !                             
233         CASE ( 05 )                              !  ORCA_R05 configuration
234            IF(  jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
235               & jpizoom ==  81    .AND. jpjzoom == 301         )   lzoom_arct = .TRUE.
236            IF(  jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
237               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
238         END SELECT
239         !
240         IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic/arctic zoom flags : '
241         IF(lwp) WRITE(numout,*) '             lzoom_arct = ', lzoom_arct, ' (T=   arctic zoom, F=global)'
242         IF(lwp) WRITE(numout,*) '             lzoom_anta = ', lzoom_anta, ' (T=antarctic zoom, F=global)'
243         !
244      ENDIF
245      !
246   END SUBROUTINE dom_glo
247
248   !!======================================================================
249END MODULE domcfg
Note: See TracBrowser for help on using the repository browser.