source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90 @ 6204

Last change on this file since 6204 was 6204, checked in by cetlod, 5 years ago

back the nemo_v3_6_STABLE_XIOS2 branch into 3_6_STABLE, including bugfixes, XIOS2 and new AGRIF

  • Property svn:keywords set to Id
File size: 3.8 KB
Line 
1#define TWO_WAY
2#undef DECAL_FEEDBACK
3
4MODULE agrif_top_update
5
6#if defined key_agrif && defined key_top
7   USE par_oce
8   USE oce
9   USE dom_oce
10   USE agrif_oce
11   USE par_trc
12   USE trc
13   USE wrk_nemo 
14
15   IMPLICIT NONE
16   PRIVATE
17
18   PUBLIC Agrif_Update_Trc
19
20   INTEGER, PUBLIC :: nbcline_trc = 0
21
22   !!----------------------------------------------------------------------
23   !! NEMO/NST 3.3 , NEMO Consortium (2010)
24   !! $Id$
25   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30   SUBROUTINE Agrif_Update_Trc( kt )
31      !!---------------------------------------------
32      !!   *** ROUTINE Agrif_Update_Trc ***
33      !!---------------------------------------------
34      INTEGER, INTENT(in) :: kt
35      !!---------------------------------------------
36      !
37      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
38#if defined TWO_WAY   
39      Agrif_UseSpecialValueInUpdate = .TRUE.
40      Agrif_SpecialValueFineGrid = 0.
41      !
42      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
43# if ! defined DECAL_FEEDBACK
44         CALL Agrif_Update_Variable(trn_id, procname=updateTRC)
45# else
46         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC)
47# endif
48      ELSE
49# if ! defined DECAL_FEEDBACK
50         CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC)
51# else
52         CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC)
53# endif
54      ENDIF
55      !
56      Agrif_UseSpecialValueInUpdate = .FALSE.
57      nbcline_trc = nbcline_trc + 1
58#endif
59      !
60   END SUBROUTINE Agrif_Update_Trc
61
62   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
63      !!---------------------------------------------
64      !!           *** ROUTINE updateT ***
65      !!---------------------------------------------
66#  include "domzgr_substitute.h90"
67      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
68      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
69      LOGICAL, INTENT(in) :: before
70      !!
71      INTEGER :: ji,jj,jk,jn
72      !!---------------------------------------------
73      !
74      IF (before) THEN
75         DO jn = n1,n2
76            DO jk=k1,k2
77               DO jj=j1,j2
78                  DO ji=i1,i2
79                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
80                  END DO
81               END DO
82            END DO
83         END DO
84      ELSE
85         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
86            ! Add asselin part
87            DO jn = n1,n2
88               DO jk=k1,k2
89                  DO jj=j1,j2
90                     DO ji=i1,i2
91                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
92                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
93                                 & + atfp * ( ptab(ji,jj,jk,jn) &
94                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
95                        ENDIF
96                     ENDDO
97                  ENDDO
98               ENDDO
99            ENDDO
100         ENDIF
101         DO jn = n1,n2
102            DO jk=k1,k2
103               DO jj=j1,j2
104                  DO ji=i1,i2
105                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
106                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
107                     END IF
108                  END DO
109               END DO
110            END DO
111         END DO
112      ENDIF
113      !
114   END SUBROUTINE updateTRC
115
116#else
117CONTAINS
118   SUBROUTINE agrif_top_update_empty
119      !!---------------------------------------------
120      !!   *** ROUTINE agrif_Top_update_empty ***
121      !!---------------------------------------------
122      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
123   END SUBROUTINE agrif_top_update_empty
124#endif
125END MODULE agrif_top_update
Note: See TracBrowser for help on using the repository browser.