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