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 branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90 @ 8809

Last change on this file since 8809 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

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