source: branches/UKMO/r6232_tracer_advection/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

File size: 8.4 KB
Line 
1MODULE mixed_grid
2!!-----------------------------------------------------------
3!!
4!!       tools box to create a mixed grid storing
5!!           the known values of grids U,V,T,F
6!!
7!!         Created by Brice Lemaire on 01/2010.
8!!
9!!-----------------------------------------------------------
10  USE readwrite
11  !
12  IMPLICIT NONE
13  PUBLIC
14  !
15  CONTAINS
16  !********************************************************
17  !            SUBROUTINE define_mixed_grid             *
18  !                                            *
19  !         to define the size of the mixed grid        *
20  !                                          *
21  !            CALL from create_coordinates             *
22  !********************************************************
23  SUBROUTINE define_mixed_grid
24    !
25    INTEGER :: ixgmix, iygmix
26    INTEGER :: ii, ij
27    !
28   WRITE(*,*) ''
29   WRITE(*,*) ' ### SUBROUTINE define_mixed_grid ### '
30   WRITE(*,*) ''
31   !
32   WRITE(*,*) ' *** CHECKING SIZE OF COARSE DOMAIN *** '
33   WRITE(*,*) nxcoag, 'x', nycoag
34   WRITE(*,*) ''
35   !
36    !*************************************
37   !!!Calculate size of mixed grid (ixgmix x iygmix)
38    !*************************************
39   IF(.NOT.nglobal) THEN
40     ixgmix = (nxcoag) * 2                              !known points (T,U,V,F) along x
41     ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)!-1)           !points to interpolate    ''
42     !
43     iygmix = (nycoag) * 2                              !known points (T,U,V,F) along y
44     iygmix = iygmix + (nn_rhoy-1)*(iygmix)!-1)           !points to interpolate    ''
45   ELSEIF(nglobal) THEN
46     ixgmix = (nxcoag) * 2                             
47     ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)             
48     !
49     iygmix = (nycoag) * 2                           
50     iygmix = iygmix + (nn_rhoy-1)*(iygmix)     
51   ENDIF
52   !
53   nxgmix = ixgmix
54   nygmix = iygmix
55   !
56   WRITE(*,*) ''
57   WRITE(*,*) '*** SIZE OF MIXED GRID ***'
58   WRITE(*,*) nxgmix, ' x ', nygmix
59   WRITE(*,*) ''
60    !
61    CALL mixed_grid_allocate(smixgrd,ixgmix,iygmix)     !using type.f90
62    !
63   IF(nglobal)THEN
64     ii = 1
65      ij = 1
66    ELSE
67     ii = nn_imin-1
68     ij = nn_jmin-1
69   ENDIF
70   !
71    CALL write_mixed_grid(ixgmix,iygmix,ii,ij)   
72    !
73   WRITE(*,*) ''
74   WRITE(*,*) ' ### END SUBROUTINE define_mixed_grid ### '
75   WRITE(*,*) '' 
76   !
77  END SUBROUTINE
78  !
79  !
80  !
81  !********************************************************
82  !           SUBROUTINE write_mixed_grid            *
83  !                                            *
84  !  to write the known values into the mixed grid      *
85  !   These known values are spaced every (nn_rho-1) points *
86  !       for allowing to compute the interpolation         *
87  !               inside this same grid                 *
88  !                                            *
89  !********************************************************
90  SUBROUTINE write_mixed_grid(ki_end,kj_end,ki_min,kj_min)
91    !
92   INTEGER, INTENT(IN) :: ki_end, kj_end
93   INTEGER, INTENT(INOUT) :: ki_min, kj_min
94   INTEGER :: ji_start, jj_start
95   INTEGER :: ji,jj
96   INTEGER :: isym_x, isym_y
97   INTEGER :: itmp1, itmp2, itmp3, itmp4, itmp5, itmp6, itmp7
98    INTEGER :: icorrxt, icorrxu, icorrxv, icorrxf      !correction factor for i-indexation
99    INTEGER :: icorryt, icorryu, icorryv, icorryf      !correction factor for j-indexation
100   LOGICAL :: llp = .TRUE.
101   LOGICAL :: llq = .TRUE.
102   !
103   WRITE(*,*) ''
104   WRITE(*,*) ' ### SUBROUTINE write_mixed_grid ### '
105   WRITE(*,*) '' 
106   !
107   ji_start = 1
108   jj_start = 1   
109    !
110   isym_y = 1
111   !
112   ! correction factor for symmetry along north boundary
113   icorrxt = 0
114   icorrxu = 0
115   icorrxv = 0
116   icorrxf = 0
117    !
118   icorryt = 0
119   icorryu = 0
120   icorryv = 0
121   icorryf = 0
122   !
123   DO jj=nn_rhoy,kj_end,2*nn_rhoy
124      !
125     DO ji=nn_rhox,ki_end,2*nn_rhox
126        !
127      smixgrd%nav_lon(ji,jj)              =  scoagrd%nav_lon(ki_min + icorrxt, kj_min + icorryt)
128      smixgrd%nav_lat(ji,jj)              =  scoagrd%nav_lat(ki_min + icorrxt, kj_min + icorryt)       
129      !
130      smixgrd%glam(ji,jj)                 =  scoagrd%glamt(ki_min + icorrxt, kj_min + icorryt)
131      smixgrd%glam(ji+nn_rhox,jj)         =  scoagrd%glamu(ki_min + icorrxu, kj_min + icorryu)
132      smixgrd%glam(ji,jj+nn_rhoy)         =  scoagrd%glamv(ki_min + icorrxv, kj_min + icorryv)
133      smixgrd%glam(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%glamf(ki_min + icorrxf, kj_min + icorryf)         
134      !
135      smixgrd%gphi(ji,jj)                 =  scoagrd%gphit(ki_min + icorrxt, kj_min + icorryt)
136      smixgrd%gphi(ji+nn_rhox,jj)         =  scoagrd%gphiu(ki_min + icorrxu, kj_min + icorryu)     
137      smixgrd%gphi(ji,jj+nn_rhoy)         =  scoagrd%gphiv(ki_min + icorrxv, kj_min + icorryv)
138      smixgrd%gphi(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%gphif(ki_min + icorrxf, kj_min + icorryf)
139      !
140      smixgrd%e1(ji,jj)                   =  scoagrd%e1t(ki_min + icorrxt, kj_min + icorryt)
141      smixgrd%e1(ji+nn_rhox,jj)           =  scoagrd%e1u(ki_min + icorrxu, kj_min + icorryu)     
142      smixgrd%e1(ji,jj+nn_rhoy)           =  scoagrd%e1v(ki_min + icorrxv, kj_min + icorryv)
143      smixgrd%e1(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e1f(ki_min + icorrxf, kj_min + icorryf) 
144     
145      smixgrd%e2(ji,jj)                   =  scoagrd%e2t(ki_min + icorrxt, kj_min + icorryt)
146      smixgrd%e2(ji+nn_rhox,jj)           =  scoagrd%e2u(ki_min + icorrxu, kj_min + icorryu)     
147      smixgrd%e2(ji,jj+nn_rhoy)           =  scoagrd%e2v(ki_min + icorrxv, kj_min + icorryv)
148      smixgrd%e2(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e2f(ki_min + icorrxf, kj_min + icorryf)
149        !
150      IF(.NOT.nglobal)THEN
151        IF(ki_min.EQ.nsizex.AND.nn_imin.NE.2) THEN          ! across right/left boundary BUT not all around the earth
152         ki_min = 3
153        ELSEIF(isym_y.EQ.1) THEN                            ! normal case
154         ki_min = ki_min + 1                               
155        ELSEIF(isym_y.EQ.-1) THEN                           ! symetry along north boundary
156         ki_min = ki_min - 1             
157        ENDIF
158      ELSE
159        ki_min = ki_min + 1
160      ENDIF
161        !
162     ENDDO
163      !   
164     !
165     ! when we reach north boundary
166     IF(.NOT.nglobal)THEN
167      IF(kj_min.EQ.nsizey-npivot-1.AND.llp) THEN           ! npivot => pivot located on T-point or F-point
168        llp = .FALSE.
169        kj_min = nsizey 
170        isym_y = -1
171        IF(nn_imin.LT.nmid.AND.nn_imax.LT.nmid) THEN       ! no bipole (from Asia to Canada)                               
172         itmp1 = nsizex - nn_imin + 2 + npivot             
173         isym_x = 1
174        ELSEIF(nn_imin.GT.nmid.AND.nn_imax.GT.nmid) THEN   ! no bipole (from Canada to Asia)
175         itmp2 = nsizex - nn_imin + 2 + npivot                     
176         isym_x = 2
177        ELSEIF(nn_imin.LT.nmid.AND.nn_imax.GT.nmid) THEN   ! canadian bipole
178         IF(nval1.LT.nval2) THEN
179           itmp3 = nmid + nval2 
180           isym_x = 3
181         ELSEIF(nval1.GE.nval2) THEN                      ! canadian bipole
182           itmp4 = nmid + nval1 + 2 - npivot
183           isym_x = 4
184         ENDIF
185        ELSEIF(ki_min.EQ.nsizex.AND.nval1.GT.nval2) THEN   ! asian bipole
186           itmp5 = nval1 + 1 + npivot
187           isym_x = 5
188        ELSEIF(ki_min.EQ.nsizex.AND.nval1.LT.nval2) THEN   ! asian bipole
189           itmp6 = nval2 + 1
190           isym_x = 6     
191        ELSEIF(ki_min.GE.nmid) THEN                        ! all around the earth (2 bipoles)
192           itmp7 = nsizex 
193           isym_x = 7
194        ENDIF
195      ENDIF
196       !
197       !
198       !
199       IF(isym_y.EQ.1) THEN
200          kj_min = kj_min + 1                   ! cas normal
201          ki_min = nn_imin - 1   
202       ELSEIF(isym_y.EQ.-1) THEN                             
203        kj_min = kj_min - 1 
204        !
205        icorrxt = 0   
206        icorrxu = -1 
207        icorrxv = 0   
208        icorrxf = -1 
209        !
210        icorryt = 0   
211        icorryu = 0   
212        icorryv = -1 
213        icorryf = -1 
214        !           
215        IF(isym_x.EQ.1) THEN                  ! no bipole
216         ki_min = itmp1
217         IF(llq)THEN
218           icorrxt = 0   
219           icorrxu = -1 + npivot
220           icorrxv = 0   
221           !
222           icorryt = 0   
223           icorryu = 0   
224           icorryv = -1 + npivot 
225           
226           llq = .FALSE.
227         ENDIF   
228          ELSEIF(isym_x.EQ.2) THEN              ! no bipole
229          ki_min = itmp2 
230         ELSEIF(isym_x.EQ.3) THEN              ! canadian bipole
231          ki_min = itmp3   
232         ELSEIF(isym_x.EQ.4) THEN              ! canadian bipole
233          ki_min = itmp4 
234          IF(llq)THEN
235           icorrxt = 0   
236           icorrxu = -1 + npivot
237           icorrxv = 0   
238           !
239           icorryt = 0   
240           icorryu = 0   
241           icorryv = -1 + npivot 
242           
243           llq = .FALSE.
244          ENDIF   
245        ELSEIF(isym_x.EQ.5) THEN              ! asian bipole
246          ki_min = itmp5         
247         ELSEIF(isym_x.EQ.6) THEN              ! asian bipole
248          ki_min = itmp6     
249        ELSEIF(isym_x.EQ.7) THEN              ! all around the earth (2 bipoles)
250          ki_min = itmp7   
251        ENDIF
252        !
253       ENDIF
254      !
255     ELSEIF(nglobal) THEN
256        kj_min = kj_min + 1                   
257       ki_min = 1     
258     ENDIF
259   ENDDO
260   !
261   WRITE(*,*) ''
262   WRITE(*,*) ' ### END SUBROUTINE write_mixed_grid ### '
263   WRITE(*,*) ''   
264   !
265  END SUBROUTINE
266  !
267END MODULE
Note: See TracBrowser for help on using the repository browser.