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_top_interp.F90 in trunk/NEMO/NST_SRC – NEMO

source: trunk/NEMO/NST_SRC/agrif_top_interp.F90 @ 706

Last change on this file since 706 was 699, checked in by smasson, 17 years ago

insert revision Id
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 4.9 KB
Line 
1   !!----------------------------------------------------------------------
2   !! $Id$
3   !!----------------------------------------------------------------------
4MODULE agrif_top_interp
5#if defined key_agrif && defined key_passivetrc
6   USE par_oce
7   USE oce
8   USE dom_oce     
9   USE sol_oce
10   USE trcstp
11   USE sms
12
13   IMPLICIT NONE
14   PRIVATE
15
16   PUBLIC Agrif_trc
17
18   CONTAINS
19
20   SUBROUTINE Agrif_trc( kt )
21      !!---------------------------------------------
22      !!   *** ROUTINE Agrif_trc ***
23      !!---------------------------------------------
24#  include "domzgr_substitute.h90" 
25#  include "vectopt_loop_substitute.h90"
26     
27      INTEGER, INTENT(in) :: kt
28
29      INTEGER :: ji,jj,jk,jn
30      REAL(wp) :: zrhox
31      REAL(wp) :: alpha1, alpha2, alpha3, alpha4
32      REAL(wp) :: alpha5, alpha6, alpha7
33      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra
34     
35      IF (Agrif_Root()) RETURN
36
37      Agrif_SpecialValue=0.
38      Agrif_UseSpecialValue = .TRUE.
39      ztra = 0.e0
40
41      CALL Agrif_Bc_variable(ztra,trn)
42      Agrif_UseSpecialValue = .FALSE.
43
44      zrhox = Agrif_Rhox()
45
46      alpha1 = (zrhox-1.)/2.
47      alpha2 = 1.-alpha1
48
49      alpha3 = (zrhox-1)/(zrhox+1)
50      alpha4 = 1.-alpha3
51
52      alpha6 = 2.*(zrhox-1.)/(zrhox+1.)
53      alpha7 = -(zrhox-1)/(zrhox+3)
54      alpha5 = 1. - alpha6 - alpha7
55
56      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
57         tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:)
58         DO jn=1,jptra 
59            DO jk=1,jpk     
60               DO jj=1,jpj
61                  IF (umask(nlci-2,jj,jk).EQ.0.) THEN
62                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
63                  ELSE
64                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
65                     IF (un(nlci-2,jj,jk).GT.0.) THEN
66                        tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) &
67                           +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk)
68                     ENDIF
69                  ENDIF
70               END DO
71            END DO
72         END DO
73      ENDIF
74
75      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
76         tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)
77         DO jn=1, jptra           
78            DO jk=1,jpk     
79               DO ji=1,jpi
80                  IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN
81                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
82                  ELSE
83                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)       
84                     IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN
85                        tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) &
86                           +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk)
87                     ENDIF
88                  ENDIF
89               END DO
90            END DO
91         END DO
92      ENDIF
93
94      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
95         tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:)
96         DO jn=1, jptra
97            DO jk=1,jpk     
98               DO jj=1,jpj
99                  IF (umask(2,jj,jk).EQ.0.) THEN
100                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
101                  ELSE
102                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)       
103                     IF (un(2,jj,jk).LT.0.) THEN
104                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) &
105                           +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
106                     ENDIF
107                  ENDIF
108               END DO
109            END DO
110         END DO
111      ENDIF
112
113      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
114         tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:)
115         DO jn=1, jptra 
116            DO jk=1,jpk     
117               DO ji=1,jpi
118                  IF (vmask(ji,2,jk).EQ.0.) THEN
119                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
120                  ELSE
121                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
122                     IF (vn(ji,2,jk) .LT. 0.) THEN
123                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)&
124                           +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
125                     ENDIF
126                  ENDIF
127               END DO
128            END DO
129         END DO
130      ENDIF
131
132   END SUBROUTINE Agrif_trc
133
134#else
135CONTAINS
136   SUBROUTINE Agrif_TOP_Interp_empty
137      !!---------------------------------------------
138      !!   *** ROUTINE agrif_Top_Interp_empty ***
139      !!---------------------------------------------
140      WRITE(*,*)  'agrif_top_interp : You should not have seen this print! error?'
141   END SUBROUTINE Agrif_TOP_Interp_empty
142#endif
143END MODULE agrif_top_interp
Note: See TracBrowser for help on using the repository browser.