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

source: trunk/NEMO/NST_SRC/agrif_top_update.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: 2.4 KB
Line 
1#define TWO_WAY
2
3MODULE agrif_top_update
4
5#if defined key_agrif && defined key_passivetrc
6   USE par_oce
7   USE oce
8   USE dom_oce
9   USE agrif_oce
10   USE trcstp
11   USE sms
12
13   IMPLICIT NONE
14   PRIVATE
15
16   PUBLIC Agrif_Update_Trc
17
18   INTEGER :: nbcline
19
20   CONTAINS
21
22   SUBROUTINE Agrif_Update_Trc( kt )
23      !!---------------------------------------------
24      !!   *** ROUTINE Agrif_Update_Trc ***
25      !!---------------------------------------------
26      INTEGER, INTENT(in) :: kt
27 
28      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra
29
30      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
31
32#if defined TWO_WAY
33      Agrif_UseSpecialValueInUpdate = .TRUE.
34      Agrif_SpecialValueFineGrid = 0.
35 
36     IF (MOD(nbcline,nbclineupdate) == 0) THEN
37         CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC)
38      ELSE
39         CALL Agrif_Update_Variable(ztra,trn,locupdate=(/0,2/), procname=updateTRC)
40      ENDIF
41
42      Agrif_UseSpecialValueInUpdate = .FALSE.
43#endif
44
45   END SUBROUTINE Agrif_Update_Trc
46
47   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,before)
48      !!---------------------------------------------
49      !!   *** ROUTINE UpdateTrc ***
50      !!---------------------------------------------
51#  include "domzgr_substitute.h90"
52
53      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
54      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,jptra), INTENT(inout) :: tabres
55      LOGICAL, INTENT(in) :: before
56   
57      INTEGER :: ji,jj,jk,jn
58
59      DO jn=1, jptra 
60
61         IF (before) THEN
62            DO jk=k1,k2
63               DO jj=j1,j2
64                  DO ji=i1,i2
65                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
66                  ENDDO
67               ENDDO
68            ENDDO
69         ELSE
70            DO jk=k1,k2
71               DO jj=j1,j2
72                  DO ji=i1,i2
73                     IF (tabres(ji,jj,jk,jn).NE.0.) THEN
74                        trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
75                     ENDIF
76                  ENDDO
77               ENDDO
78            ENDDO
79         ENDIF
80
81      END DO
82
83   END SUBROUTINE updateTRC
84
85#else
86CONTAINS
87   SUBROUTINE agrif_top_update_empty
88      !!---------------------------------------------
89      !!   *** ROUTINE agrif_Top_update_empty ***
90      !!---------------------------------------------
91      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
92   END SUBROUTINE agrif_top_update_empty
93#endif
94END Module agrif_top_update
Note: See TracBrowser for help on using the repository browser.