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 tags/nemo_v3_2/nemo_v3_2/NEMO/NST_SRC – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/NST_SRC/agrif_top_update.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm

File size: 2.9 KB
Line 
1#define TWO_WAY
2
3MODULE agrif_top_update
4
5#if defined key_agrif && defined key_top
6   USE par_oce
7   USE oce
8   USE dom_oce
9   USE agrif_oce
10   USE trc
11
12   IMPLICIT NONE
13   PRIVATE
14
15   PUBLIC Agrif_Update_Trc
16
17   INTEGER, PUBLIC :: nbcline_trc = 0
18
19   !!----------------------------------------------------------------------
20   !!   OPA 9.0 , LOCEAN-IPSL (2006)
21   !! $Id: agrif_top_update.F90 1300 2009-02-09 15:36:04Z rblod $
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25   CONTAINS
26
27   SUBROUTINE Agrif_Update_Trc( kt )
28      !!---------------------------------------------
29      !!   *** ROUTINE Agrif_Update_Trc ***
30      !!---------------------------------------------
31      INTEGER, INTENT(in) :: kt
32 
33      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra
34
35      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
36
37#if defined TWO_WAY
38      Agrif_UseSpecialValueInUpdate = .TRUE.
39      Agrif_SpecialValueFineGrid = 0.
40 
41     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
42         CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC)
43      ELSE
44         CALL Agrif_Update_Variable(ztra,trn,locupdate=(/0,2/), procname=updateTRC)
45      ENDIF
46
47      Agrif_UseSpecialValueInUpdate = .FALSE.
48      nbcline_trc = nbcline_trc + 1
49#endif
50
51   END SUBROUTINE Agrif_Update_Trc
52
53   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before)
54      !!---------------------------------------------
55      !!   *** ROUTINE UpdateTrc ***
56      !!---------------------------------------------
57#  include "domzgr_substitute.h90"
58
59      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
60      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
61      LOGICAL, INTENT(in) :: before
62   
63      INTEGER :: ji,jj,jk,jl
64
65         IF (before) THEN
66            DO jl=l1,l2
67               DO jk=k1,k2
68                  DO jj=j1,j2
69                     DO ji=i1,i2
70                        tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl)
71                     ENDDO
72                  ENDDO
73               ENDDO
74            ENDDO
75         ELSE
76            DO jl=l1,l2
77               DO jk=k1,k2
78                  DO jj=j1,j2
79                     DO ji=i1,i2
80                        IF (tabres(ji,jj,jk,jl).NE.0.) THEN
81                           trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)
82                        ENDIF
83                     ENDDO
84                  ENDDO
85               ENDDO
86            ENDDO
87         ENDIF
88
89   END SUBROUTINE updateTRC
90
91#else
92CONTAINS
93   SUBROUTINE agrif_top_update_empty
94      !!---------------------------------------------
95      !!   *** ROUTINE agrif_Top_update_empty ***
96      !!---------------------------------------------
97      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
98   END SUBROUTINE agrif_top_update_empty
99#endif
100END Module agrif_top_update
Note: See TracBrowser for help on using the repository browser.