#define TWO_WAY #undef DECAL_FEEDBACK MODULE agrif_top_update #if defined key_agrif && defined key_top USE par_oce USE oce USE dom_oce USE agrif_oce USE par_trc USE trc USE wrk_nemo IMPLICIT NONE PRIVATE PUBLIC Agrif_Update_Trc INTEGER, PUBLIC :: nbcline_trc = 0 !!---------------------------------------------------------------------- !! NEMO/NST 3.3 , NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE Agrif_Update_Trc( ) !!--------------------------------------------- !! *** ROUTINE Agrif_Update_Trc *** !!--------------------------------------------- !!--------------------------------------------- ! IF (Agrif_Root()) RETURN #if defined TWO_WAY IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update trc from grid Number',Agrif_Fixed(), 'nbcline_trc', nbcline_trc Agrif_UseSpecialValueInUpdate = .TRUE. Agrif_SpecialValueFineGrid = 0. ! IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN # if ! defined DECAL_FEEDBACK CALL Agrif_Update_Variable(trn_id, procname=updateTRC) # else CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) # endif ELSE # if ! defined DECAL_FEEDBACK CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) # else CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) # endif ENDIF ! Agrif_UseSpecialValueInUpdate = .FALSE. nbcline_trc = nbcline_trc + 1 ! #endif ! END SUBROUTINE Agrif_Update_Trc SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) !!--------------------------------------------- !! *** ROUTINE updateT *** !!--------------------------------------------- # include "domzgr_substitute.h90" INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab LOGICAL, INTENT(in) :: before !! INTEGER :: ji,jj,jk,jn REAL(wp) :: ztb, ztnu, ztno !!--------------------------------------------- ! IF (before) THEN DO jn = n1,n2 DO jk=k1,k2 DO jj=j1,j2 DO ji=i1,i2 !> jc tmp ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) ! ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) !< jc tmp END DO END DO END DO END DO ELSE !> jc tmp DO jn = n1,n2 ptab(i1:i2,j1:j2,k1:k2,jn) = ptab(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) ENDDO !< jc tmp IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part DO jn = n1,n2 DO jk=k1,k2 DO jj=j1,j2 DO ji=i1,i2 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN ztb = trb(ji,jj,jk,jn) * fse3t_b(ji,jj,jk) ! fse3t_b prior update should be used ztnu = ptab(ji,jj,jk,jn) ztno = trn(ji,jj,jk,jn) * fse3t_a(ji,jj,jk) trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & & * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk) ENDIF ENDDO ENDDO ENDDO ENDDO ENDIF DO jn = n1,n2 DO jk=k1,k2 DO jj=j1,j2 DO ji=i1,i2 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) / fse3t_n(ji,jj,jk) END IF END DO END DO END DO END DO ! IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN trb(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) ENDIF ! ENDIF ! END SUBROUTINE updateTRC #else CONTAINS SUBROUTINE agrif_top_update_empty !!--------------------------------------------- !! *** ROUTINE agrif_Top_update_empty *** !!--------------------------------------------- WRITE(*,*) 'agrif_top_update : You should not have seen this print! error?' END SUBROUTINE agrif_top_update_empty #endif END MODULE agrif_top_update