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