| 1 | MODULE agrif_dom_update |
|---|
| 2 | |
|---|
| 3 | USE dom_oce |
|---|
| 4 | USE domzgr |
|---|
| 5 | USE agrif_parameters |
|---|
| 6 | USE agrif_profiles |
|---|
| 7 | |
|---|
| 8 | IMPLICIT none |
|---|
| 9 | PRIVATE |
|---|
| 10 | |
|---|
| 11 | PUBLIC agrif_update_all |
|---|
| 12 | |
|---|
| 13 | CONTAINS |
|---|
| 14 | |
|---|
| 15 | #if defined key_agrif |
|---|
| 16 | |
|---|
| 17 | SUBROUTINE agrif_update_all |
|---|
| 18 | !!---------------------------------------------------------------------- |
|---|
| 19 | !! *** ROUTINE agrif_update_all *** |
|---|
| 20 | !!---------------------------------------------------------------------- |
|---|
| 21 | ! |
|---|
| 22 | IF( Agrif_Root() ) return |
|---|
| 23 | |
|---|
| 24 | CALL agrif_update_variable(bottom_level_id,locupdate=(/npt_copy,0/),procname = update_bottom_level) |
|---|
| 25 | ! |
|---|
| 26 | Agrif_UseSpecialValueInUpdate = .TRUE. |
|---|
| 27 | Agrif_SpecialValueFineGrid = 0._wp |
|---|
| 28 | CALL agrif_update_variable(e3t_id,procname = update_e3t) |
|---|
| 29 | Agrif_UseSpecialValueInUpdate = .FALSE. |
|---|
| 30 | ! |
|---|
| 31 | END SUBROUTINE agrif_update_all |
|---|
| 32 | |
|---|
| 33 | SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir) |
|---|
| 34 | !!---------------------------------------------------------------------- |
|---|
| 35 | !! *** ROUTINE interpsshn *** |
|---|
| 36 | !!---------------------------------------------------------------------- |
|---|
| 37 | INTEGER , INTENT(in ) :: i1, i2, j1, j2 |
|---|
| 38 | REAL, DIMENSION(i1:i2,j1:j2) , INTENT(inout) :: ptab |
|---|
| 39 | LOGICAL , INTENT(in ) :: before |
|---|
| 40 | INTEGER , INTENT(in ) :: nb , ndir |
|---|
| 41 | ! |
|---|
| 42 | !!---------------------------------------------------------------------- |
|---|
| 43 | ! |
|---|
| 44 | IF( before) THEN |
|---|
| 45 | ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2) |
|---|
| 46 | ELSE |
|---|
| 47 | mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2)) |
|---|
| 48 | |
|---|
| 49 | WHERE ( mbkt(i1:i2,j1:j2) .EQ. 0 ) |
|---|
| 50 | ssmask(i1:i2,j1:j2) = 0. |
|---|
| 51 | ELSEWHERE |
|---|
| 52 | ssmask(i1:i2,j1:j2) = 1. |
|---|
| 53 | END WHERE |
|---|
| 54 | ENDIF |
|---|
| 55 | ! |
|---|
| 56 | END SUBROUTINE update_bottom_level |
|---|
| 57 | |
|---|
| 58 | SUBROUTINE update_e3t( tabres, i1, i2, j1, j2, k1, k2, before ) |
|---|
| 59 | !!--------------------------------------------- |
|---|
| 60 | !! *** update_e3t *** |
|---|
| 61 | !!--------------------------------------------- |
|---|
| 62 | INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 |
|---|
| 63 | REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres |
|---|
| 64 | LOGICAL, INTENT(in) :: before |
|---|
| 65 | !! |
|---|
| 66 | INTEGER :: ji,jj,jk |
|---|
| 67 | !!--------------------------------------------- |
|---|
| 68 | ! |
|---|
| 69 | IF (before) THEN |
|---|
| 70 | DO jk=k1,k2 |
|---|
| 71 | DO jj=j1,j2 |
|---|
| 72 | DO ji=i1,i2 |
|---|
| 73 | IF( mbkt(ji,jj) .LE. jk ) THEN |
|---|
| 74 | tabres(ji,jj,jk) = e3t_0(ji,jj,jk) |
|---|
| 75 | ELSE |
|---|
| 76 | tabres(ji,jj,jk) = 0. |
|---|
| 77 | endif |
|---|
| 78 | END DO |
|---|
| 79 | END DO |
|---|
| 80 | END DO |
|---|
| 81 | ELSE |
|---|
| 82 | DO jk=k1,k2 |
|---|
| 83 | DO jj=j1,j2 |
|---|
| 84 | DO ji=i1,i2 |
|---|
| 85 | IF( mbkt(ji,jj) .LE.jk ) THEN |
|---|
| 86 | e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)) |
|---|
| 87 | ELSE |
|---|
| 88 | e3t_0(ji,jj,jk) = e3t_1d(jk) |
|---|
| 89 | ENDIF |
|---|
| 90 | END DO |
|---|
| 91 | END DO |
|---|
| 92 | END DO |
|---|
| 93 | ! |
|---|
| 94 | ENDIF |
|---|
| 95 | ! |
|---|
| 96 | END SUBROUTINE update_e3t |
|---|
| 97 | |
|---|
| 98 | #else |
|---|
| 99 | SUBROUTINE agrif_update_all |
|---|
| 100 | END SUBROUTINE agrif_update_all |
|---|
| 101 | #endif |
|---|
| 102 | |
|---|
| 103 | END MODULE agrif_dom_update |
|---|
