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.
agrif_connection.F90 in utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src – NEMO

source: utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/agrif_connection.F90 @ 13024

Last change on this file since 13024 was 13024, checked in by rblod, 4 years ago

First version of new nesting tools merged with domaincfg, see ticket #2129

File size: 5.6 KB
Line 
1#if defined key_agrif
2   SUBROUTINE Agrif_connection
3   use dom_oce
4   use agrif_parameters
5      !!----------------------------------------------------------------------
6      !!                 *** ROUTINE  Agrif_Sponge ***
7      !!----------------------------------------------------------------------
8      INTEGER  ::   ji, jj, ind1, ind2
9      INTEGER  ::   ispongearea, istart
10      REAL(wp) ::   z1_spongearea
11      !!----------------------------------------------------------------------
12      !
13         ! Define ramp from boundaries towards domain interior at T-points
14         ! Store it in ztabramp
15
16         ALLOCATE(ztabramp(jpi,jpj))
17         ispongearea = 1 + npt_connect * Agrif_irhox()
18         istart = npt_copy * Agrif_irhox()
19         z1_spongearea = 1._wp / REAL( ispongearea )
20         
21         ztabramp(:,:) = 0._wp
22
23         ! --- West --- !
24         IF( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN
25            ind1 = 1+nbghostcells + istart
26            ind2 = ind1 + ispongearea 
27            DO jj = 1, jpj
28               DO ji = ind1, ind2               
29                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
30               END DO
31            ENDDO
32         ENDIF
33
34         ! --- East --- !
35         IF( ((nbondi == 1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN
36            !ind1 = nlci - nbghostcells - ispongearea
37            ind2 = nlci - nbghostcells - istart
38            ind1 = ind2 -ispongearea
39           
40           
41            DO jj = 1, jpj
42               DO ji = ind1, ind2
43                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) )
44               ENDDO
45            ENDDO
46         ENDIF
47
48         ! --- South --- !
49         IF(( (nbondj == -1) .OR. (nbondj == 2) ).AND.(ln_bry_south)) THEN
50            ! ind1 = 1+nbghostcells
51            ! ind2 = 1+nbghostcells + ispongearea
52            ind1 = 1+nbghostcells + istart
53            ind2 = ind1 + ispongearea 
54            DO jj = ind1, ind2 
55               DO ji = 1, jpi
56                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
57               END DO
58            ENDDO
59         ENDIF
60
61         ! --- North --- !
62         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
63            ! ind1 = nlcj - nbghostcells - ispongearea
64            ! ind2 = nlcj - nbghostcells
65           
66            ind2 = nlcj - nbghostcells - istart
67            ind1 = ind2 -ispongearea
68           
69            DO jj = ind1, ind2
70               DO ji = 1, jpi
71                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) )
72               END DO
73            ENDDO
74         ENDIF
75      !
76      !
77   END SUBROUTINE Agrif_connection
78   
79   SUBROUTINE Agrif_make_connection
80   use dom_oce
81   use agrif_parameters
82      !!----------------------------------------------------------------------
83      !!                 *** ROUTINE  Agrif_Sponge ***
84      !!----------------------------------------------------------------------
85      INTEGER  ::   ji, jj, ind1, ind2
86      INTEGER  ::   ispongearea, istart
87      REAL(wp) ::   z1_spongearea
88      !!----------------------------------------------------------------------
89      !
90         ! Define ramp from boundaries towards domain interior at T-points
91         ! Store it in ztabramp
92
93         ispongearea = 1 + npt_connect * Agrif_irhox()
94         istart = npt_copy * Agrif_irhox()
95
96         ! --- West --- !
97         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
98           
99            ind1 = 1+nbghostcells + istart
100            ind2 = ind1 + ispongearea
101            DO jk=1,jpk           
102             DO jj = 1, jpj
103               DO ji = ind1, ind2
104               
105                ! print *,'VAL = ',ztabramp(ji,jj)*e3t_interp(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_0(ji,jj,jk), &
106                ! e3t_0(ji,jj,jk)
107                  e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_interp(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_0(ji,jj,jk)
108               ENDDO
109              ENDDO
110            ENDDO
111         ENDIF
112
113         ! --- East --- !
114         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
115            ind2 = nlci - nbghostcells - istart
116            ind1 = ind2 -ispongearea
117            DO jk=1,jpk   
118            DO jj = 1, jpj
119               DO ji = ind1, ind2
120                  e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_interp(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_0(ji,jj,jk)
121               ENDDO
122            ENDDO
123            ENDDO
124         ENDIF
125
126         ! --- South --- !
127         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
128            ind1 = 1+nbghostcells + istart
129            ind2 = ind1 + ispongearea 
130            DO jk=1,jpk   
131            DO jj = ind1, ind2 
132               DO ji = 1, jpi
133                  e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_interp(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_0(ji,jj,jk)
134               END DO
135            ENDDO
136            ENDDO
137         ENDIF
138
139         ! --- North --- !
140         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
141           
142            ind2 = nlcj - nbghostcells - istart
143            ind1 = ind2 -ispongearea
144            DO jk=1,jpk               
145            DO jj = ind1, ind2
146               DO ji = 1, jpi
147                  e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_interp(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_0(ji,jj,jk)
148               END DO
149            ENDDO
150            ENDDO
151         ENDIF
152      !
153      !
154   END SUBROUTINE Agrif_make_connection
155   
156#else
157subroutine agrif_connection_empty
158end subroutine agrif_connection_empty
159#endif
Note: See TracBrowser for help on using the repository browser.