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 @ 1146

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

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