- Timestamp:
- 2017-04-23T09:30:41+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r7761 r7953 31 31 PRIVATE 32 32 33 PUBLIC agrif_update_lim333 PUBLIC agrif_update_lim3 ! called by ???? 34 34 35 35 !!---------------------------------------------------------------------- 36 !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)36 !! NEMO/NST 4.0 , LOCEAN-IPSL (2017) 37 37 !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $ 38 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- 40 41 40 CONTAINS 42 41 … … 49 48 !!---------------------------------------------------------------------- 50 49 INTEGER, INTENT(in) :: kt 51 !!52 50 !!---------------------------------------------------------------------- 53 51 ! … … 57 55 ! i.e. update only at the parent time step 58 56 Agrif_UseSpecialValueInUpdate = .TRUE. 59 Agrif_SpecialValueFineGrid = -9999.57 Agrif_SpecialValueFineGrid = -9999. 60 58 # if defined TWO_WAY 61 59 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps … … 75 73 76 74 77 !!------------------78 !! Local subroutines79 !!------------------80 75 SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before ) 81 76 !!----------------------------------------------------------------------- … … 84 79 !! the properties per mass on the coarse grid 85 80 !!----------------------------------------------------------------------- 86 INTEGER , INTENT(in) ::i1, i2, j1, j2, k1, k287 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab88 LOGICAL , INTENT(in) ::before81 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 82 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 83 LOGICAL , INTENT(in ) :: before 89 84 !! 90 85 INTEGER :: jk, jl, jm … … 94 89 jm = 1 95 90 DO jl = 1, jpl 96 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ;jm = jm + 197 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ;jm = jm + 198 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ;jm = jm + 199 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ;jm = jm + 1100 ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ;jm = jm + 191 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ; jm = jm + 1 92 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ; jm = jm + 1 93 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ; jm = jm + 1 94 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 95 ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 101 96 DO jk = 1, nlay_s 102 ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ;jm = jm + 1103 END DO97 ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 98 END DO 104 99 DO jk = 1, nlay_i 105 ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ;jm = jm + 1106 END DO107 END DO100 ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 101 END DO 102 END DO 108 103 109 104 DO jk = k1, k2 110 105 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:,jk) = -9999. 111 END DO112 106 END DO 107 ! 113 108 ELSE 114 109 jm = 1 115 110 DO jl = 1, jpl 116 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1117 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1118 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1119 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1120 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1111 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 112 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 113 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 114 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 115 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 121 116 DO jk = 1, nlay_s 122 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1117 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 123 118 ENDDO 124 119 DO jk = 1, nlay_i 125 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1126 END DO127 END DO120 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 121 END DO 122 END DO 128 123 129 124 ! integrated values … … 144 139 !! ** Method : Update the fluxes and recover the properties (C-grid) 145 140 !!----------------------------------------------------------------------- 146 INTEGER , INTENT(in) ::i1, i2, j1, j2147 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab148 LOGICAL , INTENT(in) ::before141 INTEGER , INTENT(in ) :: i1, i2, j1, j2 142 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 143 LOGICAL , INTENT(in ) :: before 149 144 !! 150 REAL(wp) :: zrhoy145 REAL(wp) :: zrhoy ! local scalar 151 146 !!----------------------------------------------------------------------- 152 147 ! … … 154 149 zrhoy = Agrif_Rhoy() 155 150 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 156 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.151 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999. 157 152 ELSE 158 153 u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) … … 167 162 !! ** Method : Update the fluxes and recover the properties (C-grid) 168 163 !!----------------------------------------------------------------------- 169 INTEGER , INTENT(in) :: i1,i2,j1,j2170 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::ptab171 LOGICAL , INTENT(in) ::before164 INTEGER , INTENT(in ) :: i1, i2, j1, j2 165 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 166 LOGICAL , INTENT(in ) :: before 172 167 !! 173 REAL(wp) :: zrhox168 REAL(wp) :: zrhox ! local scalar 174 169 !!----------------------------------------------------------------------- 175 170 ! … … 177 172 zrhox = Agrif_Rhox() 178 173 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 179 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.174 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999. 180 175 ELSE 181 176 v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) … … 185 180 186 181 #else 182 !!---------------------------------------------------------------------- 183 !! Empty module no sea-ice 184 !!---------------------------------------------------------------------- 187 185 CONTAINS 188 186 SUBROUTINE agrif_lim3_update_empty 189 !!---------------------------------------------190 !! *** ROUTINE agrif_lim3_update_empty ***191 !!---------------------------------------------192 187 WRITE(*,*) 'agrif_lim3_update : You should not have seen this print! error?' 193 188 END SUBROUTINE agrif_lim3_update_empty 194 189 #endif 190 191 !!====================================================================== 195 192 END MODULE agrif_lim3_update
Note: See TracChangeset
for help on using the changeset viewer.
