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
RevLine 
[628]1#define TWO_WAY
[6204]2#undef DECAL_FEEDBACK
[628]3
[636]4MODULE agrif_top_update
5
[1206]6#if defined key_agrif && defined key_top
[636]7   USE par_oce
8   USE oce
9   USE dom_oce
[782]10   USE agrif_oce
[6204]11   USE par_trc
[1271]12   USE trc
[3294]13   USE wrk_nemo 
[628]14
[636]15   IMPLICIT NONE
16   PRIVATE
[628]17
[636]18   PUBLIC Agrif_Update_Trc
[628]19
[1300]20   INTEGER, PUBLIC :: nbcline_trc = 0
[628]21
[1156]22   !!----------------------------------------------------------------------
[2528]23   !! NEMO/NST 3.3 , NEMO Consortium (2010)
[1156]24   !! $Id$
[2528]25   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1156]26   !!----------------------------------------------------------------------
27
[6204]28CONTAINS
[636]29
30   SUBROUTINE Agrif_Update_Trc( kt )
31      !!---------------------------------------------
32      !!   *** ROUTINE Agrif_Update_Trc ***
33      !!---------------------------------------------
34      INTEGER, INTENT(in) :: kt
[6204]35      !!---------------------------------------------
36      !
37      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
38#if defined TWO_WAY   
[628]39      Agrif_UseSpecialValueInUpdate = .TRUE.
40      Agrif_SpecialValueFineGrid = 0.
[6204]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
[628]48      ELSE
[6204]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
[628]54      ENDIF
[6204]55      !
[628]56      Agrif_UseSpecialValueInUpdate = .FALSE.
[1300]57      nbcline_trc = nbcline_trc + 1
[628]58#endif
[6204]59      !
[636]60   END SUBROUTINE Agrif_Update_Trc
[628]61
[6204]62   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
[636]63      !!---------------------------------------------
[6204]64      !!           *** ROUTINE updateT ***
[636]65      !!---------------------------------------------
[6204]66#  include "domzgr_substitute.h90"
[3680]67      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
[6204]68      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
[636]69      LOGICAL, INTENT(in) :: before
[6204]70      !!
[3680]71      INTEGER :: ji,jj,jk,jn
[6204]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
[4491]86            ! Add asselin part
[6204]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)
[1300]95                        ENDIF
96                     ENDDO
[636]97                  ENDDO
98               ENDDO
99            ENDDO
100         ENDIF
[6204]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      !
[636]114   END SUBROUTINE updateTRC
[628]115
116#else
[636]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
[628]124#endif
[6204]125END MODULE agrif_top_update
Note: See TracBrowser for help on using the repository browser.