#define TWO_WAY #undef DECAL_FEEDBACK MODULE agrif_top_update !!====================================================================== !! *** MODULE agrif_top_update *** !! AGRIF : !!---------------------------------------------------------------------- !! History : !!---------------------------------------------------------------------- #if defined key_agrif && defined key_top USE par_oce USE oce USE par_trc USE trc USE dom_oce USE agrif_oce USE wrk_nemo IMPLICIT NONE PRIVATE PUBLIC Agrif_Update_Trc !!---------------------------------------------------------------------- !! NEMO/NST 3.7 , NEMO Consortium (2015) !! $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 Agrif_UseSpecialValueInUpdate = .TRUE. Agrif_SpecialValueFineGrid = 0._wp ! # if ! defined DECAL_FEEDBACK CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) ! CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) # else CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) ! CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) # endif ! Agrif_UseSpecialValueInUpdate = .FALSE. ! #endif ! END SUBROUTINE Agrif_Update_Trc SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) !!---------------------------------------------------------------------- !! *** ROUTINE updateTRC *** !!---------------------------------------------------------------------- INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 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 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) ! tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) !< jc tmp END DO END DO END DO END DO ELSE !> jc tmp DO jn = n1,n2 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & & * tmask(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( tabres(ji,jj,jk,jn) .NE. 0. ) THEN ztb = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used ztnu = tabres(ji,jj,jk,jn) ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & & * tmask(ji,jj,jk) / e3t_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( tabres(ji,jj,jk,jn) .NE. 0. ) THEN trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_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