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

source: trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90 @ 6140

Last change on this file since 6140 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
RevLine 
[628]1#define TWO_WAY
[5656]2#undef DECAL_FEEDBACK
[628]3
[636]4MODULE agrif_top_update
[6140]5   !!======================================================================
6   !!                ***  MODULE agrif_top_update  ***
7   !! AGRIF :   
8   !!----------------------------------------------------------------------
9   !! History : 
10   !!----------------------------------------------------------------------
[636]11
[1206]12#if defined key_agrif && defined key_top
[636]13   USE par_oce
14   USE oce
[6140]15   USE par_trc
16   USE trc
[636]17   USE dom_oce
[782]18   USE agrif_oce
[3294]19   USE wrk_nemo 
[628]20
[636]21   IMPLICIT NONE
22   PRIVATE
[628]23
[636]24   PUBLIC Agrif_Update_Trc
[628]25
[6140]26   INTEGER, PUBLIC ::   nbcline_trc = 0   !: ???
[628]27
[1156]28   !!----------------------------------------------------------------------
[6140]29   !! NEMO/NST 3.7 , NEMO Consortium (2015)
[1156]30   !! $Id$
[2528]31   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1156]32   !!----------------------------------------------------------------------
[5656]33CONTAINS
[636]34
35   SUBROUTINE Agrif_Update_Trc( kt )
[6140]36      !!----------------------------------------------------------------------
37      !!                   *** ROUTINE Agrif_Update_Trc ***
38      !!----------------------------------------------------------------------
39      INTEGER, INTENT(in) ::   kt
40      !!----------------------------------------------------------------------
[5656]41      !
42      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
43#if defined TWO_WAY   
[628]44      Agrif_UseSpecialValueInUpdate = .TRUE.
[6140]45      Agrif_SpecialValueFineGrid    = 0._wp
[5656]46      !
[6140]47      IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN
[5656]48# if ! defined DECAL_FEEDBACK
[6140]49         CALL Agrif_Update_Variable(trn_id, procname=updateTRC )
[5656]50# else
[6140]51         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC )
[5656]52# endif
[628]53      ELSE
[5656]54# if ! defined DECAL_FEEDBACK
[6140]55         CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC )
[5656]56# else
[6140]57         CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC )
[5656]58# endif
[628]59      ENDIF
[5656]60      !
[628]61      Agrif_UseSpecialValueInUpdate = .FALSE.
[1300]62      nbcline_trc = nbcline_trc + 1
[628]63#endif
[5656]64      !
[636]65   END SUBROUTINE Agrif_Update_Trc
[628]66
[6140]67
[5656]68   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
[6140]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
[5656]75      !!
[6140]76      INTEGER ::   ji, jj, jk, jn
77      !!----------------------------------------------------------------------
[5656]78      !
[6140]79      IF( before ) THEN
80         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
[5656]81      ELSE
[6140]82         IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN
[4491]83            ! Add asselin part
[5656]84            DO jn = n1,n2
[6140]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)
[1300]92                        ENDIF
[6140]93                     END DO
94                  END DO
95               END DO
96            END DO
[636]97         ENDIF
[6140]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
[5656]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      !
[636]111   END SUBROUTINE updateTRC
[628]112
113#else
[636]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
[628]121#endif
[6140]122
123   !!======================================================================
[5656]124END MODULE agrif_top_update
Note: See TracBrowser for help on using the repository browser.