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.
domain.f90 in branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/TOOLS/GRIDGEN/src – NEMO

source: branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90 @ 5477

Last change on this file since 5477 was 5477, checked in by cguiavarch, 9 years ago

Clear svn keywords from UKMO/dev_r5107_hadgem3_cplseq

File size: 4.9 KB
Line 
1MODULE domain
2!!-----------------------------------------------------------
3!!
4!!         module to define domain to extract
5!!                 from initial grid
6!!
7!!        Created by Brice Lemaire on 01/2010.
8!!
9!!-----------------------------------------------------------
10  USE readwrite
11  USE mixed_grid
12  !
13  IMPLICIT NONE
14  PUBLIC
15  !
16  CONTAINS
17  !********************************************************
18  !              SUBROUTINE  define_domain              *
19  !                                            *
20  !      to define the domain of the coarse grid        *
21  !                 which will be used                *
22  !                                                     *
23  !          CALLED from create_coordinates             *
24  !********************************************************
25  SUBROUTINE define_domain
26  !
27  WRITE(*,*) ''
28  WRITE(*,*) ' ### SUBROUTINE define_domain ### '
29  WRITE(*,*) ''
30  !
31  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32  !
33  ! *** without northern boundary ***
34  IF((nn_jmax.LT.(nsizey-1)).AND.(nn_jmax.GT.nn_jmin)) THEN             
35    !
36    WRITE(*,*) ' ****************************** ' 
37    WRITE(*,*) ' *** WITHOUT NORTH BOUNDARY *** '
38    WRITE(*,*) ' ****************************** ' 
39    !     
40   ! *** with left/right boundary ***
41   IF(nn_imin.GT.nn_imax) THEN                                       
42     nxcoag = (nsizex - (nn_imin-1) + 1) + ((nn_imax+1) - 2) 
43   ! *** all around the earth *** 
44   ELSEIF(nn_imin.EQ.nn_imax) THEN                       
45     nxcoag = nsizex
46   ELSE
47     nxcoag = (nn_imax+1) - (nn_imin-1) + 1                   
48   ENDIF
49   
50   !(+/-1) we need ghost cells to make interpolation
51   nycoag = (nn_jmax+1) - (nn_jmin-1) + 1               
52   !
53  ENDIF
54  !
55  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
56 
57  ! *** along northern boundary ***
58  IF((nn_jmax.LE.nn_jmin).OR.(nn_jmax.GE.nsizey-1)) THEN             
59    !
60    WRITE(*,*) ' **************************** ' 
61    WRITE(*,*) ' *** ALONG NORTH BOUNDARY *** '
62    WRITE(*,*) ' **************************** ' 
63   !
64   ! *** with left/right boundary ***
65   IF(nn_imin.GT.nn_imax) THEN                       
66     !
67     WRITE(*,*) '' 
68     WRITE(*,*) ' ** asian bipole ** '
69     WRITE(*,*) '' 
70     !     
71     nval1 = nsizex - nn_imin + 1
72     nval2 = nn_imax 
73     nn_jmin = nn_jmax
74     !
75     ! *** to respect symmetry around asian bipole ***
76     IF((nval1.LT.nval2).AND.(nval2.LT.nmid)) THEN       
77        !
78      nn_imin = nsizex - nval2 + 1 
79      nxcoag = nval2
80      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2     
81       !
82       ELSEIF((nval1.GE.nval2).AND.(nval1.LT.nmid)) THEN
83       !
84       nn_imax = nval1
85      nxcoag = nval1 
86      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2     
87      !
88      ! *** all around the earth ***
89       ELSE                                         
90       !
91       nn_imax = nn_imin   
92      !     
93      ENDIF
94   ENDIF
95   !
96   IF(nn_imin.LT.nn_imax) THEN                           
97     !
98     ! *** without bipole ***
99     IF(((nn_imin.LT.nmid).AND.(nn_imax.LT.nmid)).OR.((nn_imin.GT.nmid).AND.(nn_imax.GT.nmid))) THEN 
100       !
101       WRITE(*,*) '' 
102       WRITE(*,*) ' ** without bipole ** '
103       WRITE(*,*) '' 
104       !       
105       nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
106       nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 -0   
107       !
108      ! *** including canada bipole ***
109       ELSEIF((nn_imin.LE.nmid).AND.(nn_imax.GE.nmid)) THEN   
110      !
111      WRITE(*,*) '' 
112      WRITE(*,*) ' ** canadian bipole ** '
113      WRITE(*,*) '' 
114      !       
115      nn_jmin = nn_jmax
116      nval1 = nmid - nn_imin 
117      nval2 = nn_imax - (nmid-1) 
118      !
119      ! *** to respect around canada bipole ***
120      IF(nval1.LT.nval2) THEN   
121        !
122        nn_imin = nmid - nval2   
123        nxcoag = (nval2+1) 
124         nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 - (2*npivot)     
125        !
126        ELSEIF(nval1.GE.nval2) THEN
127        !
128        nn_imax = nmid + nval1
129        nxcoag = (nval1+1) 
130         nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 - (2*npivot)     
131        !
132      ENDIF   
133     ENDIF 
134    ENDIF
135  ENDIF
136    !
137    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138    !
139   IF(nglobal) THEN                                  !Global
140     !                                                Don't change the global shape of the matrix
141     WRITE(*,*) '' 
142     WRITE(*,*) ' ** global ** '
143     WRITE(*,*) '' 
144     !     
145     nn_imin = 1
146     nn_imax = nsizex
147     nn_jmin = 1
148     nn_jmax = nsizey
149     nxcoag = nsizex
150     nycoag = nsizey
151     !
152   ELSEIF(nn_imin.EQ.nn_imax) THEN      !Semi-global (e.g northern hemisphere) 
153     !                                   Change the global shape -> suppression of the northern boundary and bipoles
154     WRITE(*,*) '' 
155     WRITE(*,*) ' ** all around the earth (2 bipoles) ** '
156     WRITE(*,*) '' 
157     !     
158     nn_imin = 2 
159     nn_imax = nmid
160     nn_jmin = nn_jmax
161     nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
162     nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 
163     !
164   ENDIF
165 
166  WRITE(*,*) ''
167  WRITE(*,*) ' ### END SUBROUTINE define_domain ### '
168  WRITE(*,*) ''
169  !
170  END SUBROUTINE
171  !
172END MODULE
Note: See TracBrowser for help on using the repository browser.