- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r7761 r9019 31 31 PRIVATE 32 32 33 PUBLIC agrif_update_lim334 35 !!---------------------------------------------------------------------- 36 !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)33 PUBLIC agrif_update_lim3 ! called by agrif_user.F90 34 35 !!---------------------------------------------------------------------- 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 ! … … 56 54 IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 57 55 ! i.e. update only at the parent time step 56 IF( nn_ice == 0 ) RETURN ! do not update if child domain does not have ice 57 ! 58 Agrif_SpecialValueFineGrid = -9999. 58 59 Agrif_UseSpecialValueInUpdate = .TRUE. 59 Agrif_SpecialValueFineGrid = -9999.60 60 # if defined TWO_WAY 61 61 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps … … 70 70 ENDIF 71 71 # endif 72 Agrif_SpecialValueFineGrid = 0. 72 73 Agrif_UseSpecialValueInUpdate = .FALSE. 73 74 ! … … 75 76 76 77 77 !!------------------78 !! Local subroutines79 !!------------------80 78 SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before ) 81 79 !!----------------------------------------------------------------------- … … 84 82 !! the properties per mass on the coarse grid 85 83 !!----------------------------------------------------------------------- 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) ::before89 !! 90 INTEGER :: j k, jl, jm84 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 85 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 86 LOGICAL , INTENT(in ) :: before 87 !! 88 INTEGER :: ji, jj, jk, jl, jm 91 89 !!----------------------------------------------------------------------- 92 90 ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). … … 94 92 jm = 1 95 93 DO jl = 1, jpl 96 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ; jm = jm + 1 97 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ; jm = jm + 1 98 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 100 ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 94 ptab(i1:i2,j1:j2,jm ) = a_i (i1:i2,j1:j2,jl) 95 ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl) 96 ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl) 97 ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl) 98 ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 99 jm = jm + 5 101 100 DO jk = 1, nlay_s 102 ptab( :,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ;jm = jm + 1103 END DO101 ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 102 END DO 104 103 DO jk = 1, nlay_i 105 ptab( :,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ;jm = jm + 1106 END DO107 END DO108 104 ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 105 END DO 106 END DO 107 ! 109 108 DO jk = k1, k2 110 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:,jk) = -9999.111 END DO112 109 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 110 END DO 111 ! 113 112 ELSE 113 ! 114 114 jm = 1 115 115 DO jl = 1, jpl 116 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 117 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 118 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 119 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 120 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 116 ! 117 DO jj = j1, j2 118 DO ji = i1, i2 119 IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 120 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 121 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 122 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 123 sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 124 oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 125 ENDIF 126 END DO 127 END DO 128 jm = jm + 5 129 ! 121 130 DO jk = 1, nlay_s 122 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 123 ENDDO 131 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 132 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 133 ENDWHERE 134 jm = jm + 1 135 END DO 136 ! 124 137 DO jk = 1, nlay_i 125 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 126 ENDDO 127 ENDDO 128 138 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 139 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 140 ENDWHERE 141 jm = jm + 1 142 END DO 143 ! 144 END DO 145 ! 129 146 ! integrated values 130 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )131 vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 )132 at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 )147 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:) , dim=3 ) 148 vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:) , dim=3 ) 149 at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:) , dim=3 ) 133 150 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 134 151 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) … … 144 161 !! ** Method : Update the fluxes and recover the properties (C-grid) 145 162 !!----------------------------------------------------------------------- 146 INTEGER , INTENT(in) ::i1, i2, j1, j2147 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab148 LOGICAL , INTENT(in) ::before149 !! 150 REAL(wp) :: zrhoy163 INTEGER , INTENT(in ) :: i1, i2, j1, j2 164 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 165 LOGICAL , INTENT(in ) :: before 166 !! 167 REAL(wp) :: zrhoy ! local scalar 151 168 !!----------------------------------------------------------------------- 152 169 ! … … 154 171 zrhoy = Agrif_Rhoy() 155 172 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 156 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.173 WHERE( umask(i1:i2,j1:j2,1) == 0._wp ) ptab(:,:) = Agrif_SpecialValueFineGrid 157 174 ELSE 158 u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 175 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 176 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 177 ENDWHERE 159 178 ENDIF 160 179 ! … … 167 186 !! ** Method : Update the fluxes and recover the properties (C-grid) 168 187 !!----------------------------------------------------------------------- 169 INTEGER , INTENT(in) :: i1,i2,j1,j2170 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::ptab171 LOGICAL , INTENT(in) ::before172 !! 173 REAL(wp) :: zrhox188 INTEGER , INTENT(in ) :: i1, i2, j1, j2 189 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 190 LOGICAL , INTENT(in ) :: before 191 !! 192 REAL(wp) :: zrhox ! local scalar 174 193 !!----------------------------------------------------------------------- 175 194 ! … … 177 196 zrhox = Agrif_Rhox() 178 197 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 179 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.198 WHERE( vmask(i1:i2,j1:j2,1) == 0._wp ) ptab(:,:) = Agrif_SpecialValueFineGrid 180 199 ELSE 181 v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 200 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 201 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 202 ENDWHERE 182 203 ENDIF 183 204 ! … … 185 206 186 207 #else 208 !!---------------------------------------------------------------------- 209 !! Empty module no sea-ice 210 !!---------------------------------------------------------------------- 187 211 CONTAINS 188 212 SUBROUTINE agrif_lim3_update_empty 189 !!---------------------------------------------190 !! *** ROUTINE agrif_lim3_update_empty ***191 !!---------------------------------------------192 213 WRITE(*,*) 'agrif_lim3_update : You should not have seen this print! error?' 193 214 END SUBROUTINE agrif_lim3_update_empty 194 215 #endif 216 217 !!====================================================================== 195 218 END MODULE agrif_lim3_update
Note: See TracChangeset
for help on using the changeset viewer.