- 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_interp.F90
r7761 r7953 28 28 PRIVATE 29 29 30 PUBLIC agrif_interp_lim330 PUBLIC agrif_interp_lim3 ! called by ??? 31 31 32 32 !!---------------------------------------------------------------------- … … 46 46 !! computing factor for time interpolation 47 47 !!----------------------------------------------------------------------- 48 CHARACTER(len=1), INTENT( in ) ::cd_type49 INTEGER , INTENT( in ), OPTIONAL ::kiter, kitermax50 !! 51 REAL(wp) :: zbeta48 CHARACTER(len=1), INTENT(in ) :: cd_type 49 INTEGER , INTENT(in ), OPTIONAL :: kiter, kitermax 50 !! 51 REAL(wp) :: zbeta ! local scalar 52 52 !!----------------------------------------------------------------------- 53 53 ! 54 54 IF( Agrif_Root() ) RETURN 55 55 ! 56 SELECT CASE( cd_type)56 SELECT CASE( cd_type ) 57 57 CASE('U','V') 58 58 IF( PRESENT( kiter ) ) THEN ! interpolation at the child sub-time step (only for ice rheology) … … 66 66 END SELECT 67 67 ! 68 Agrif_SpecialValue =-9999.68 Agrif_SpecialValue = -9999. 69 69 Agrif_UseSpecialValue = .TRUE. 70 SELECT CASE(cd_type) 71 CASE('U') 72 CALL Agrif_Bc_variable( u_ice_id , procname=interp_u_ice , calledweight=zbeta ) 73 CASE('V') 74 CALL Agrif_Bc_variable( v_ice_id , procname=interp_v_ice , calledweight=zbeta ) 75 CASE('T') 76 CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta ) 70 SELECT CASE( cd_type ) 71 CASE('U') ; CALL Agrif_Bc_variable( u_ice_id , procname=interp_u_ice , calledweight=zbeta ) 72 CASE('V') ; CALL Agrif_Bc_variable( v_ice_id , procname=interp_v_ice , calledweight=zbeta ) 73 CASE('T') ; CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta ) 77 74 END SELECT 78 Agrif_SpecialValue =0.75 Agrif_SpecialValue = 0._wp 79 76 Agrif_UseSpecialValue = .FALSE. 80 77 ! 81 78 END SUBROUTINE agrif_interp_lim3 82 79 83 !!------------------ 84 !! Local subroutines 85 !!------------------ 80 86 81 SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before ) 87 82 !!----------------------------------------------------------------------- … … 92 87 !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 93 88 !!----------------------------------------------------------------------- 94 INTEGER , INTENT(in) ::i1, i2, j1, j295 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab96 LOGICAL , INTENT(in) ::before97 !! 98 REAL(wp) :: zrhoy89 INTEGER , INTENT(in ) :: i1, i2, j1, j2 90 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 91 LOGICAL , INTENT(in ) :: before 92 !! 93 REAL(wp) :: zrhoy ! local scalar 99 94 !!----------------------------------------------------------------------- 100 95 ! … … 118 113 !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 119 114 !!----------------------------------------------------------------------- 120 INTEGER , INTENT(in) ::i1, i2, j1, j2121 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab122 LOGICAL , INTENT(in) ::before123 !! 124 REAL(wp) :: zrhox115 INTEGER , INTENT(in ) :: i1, i2, j1, j2 116 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 117 LOGICAL , INTENT(in ) :: before 118 !! 119 REAL(wp) :: zrhox ! local scalar 125 120 !!----------------------------------------------------------------------- 126 121 ! … … 144 139 !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 145 140 !!----------------------------------------------------------------------- 146 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 147 INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2 148 LOGICAL , INTENT(in) :: before 149 INTEGER , INTENT(in) :: nb, ndir 150 !! 151 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab 141 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 142 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 143 LOGICAL , INTENT(in ) :: before 144 INTEGER , INTENT(in ) :: nb, ndir 145 !! 152 146 INTEGER :: ji, jj, jk, jl, jm 153 147 INTEGER :: imin, imax, jmin, jmax 148 LOGICAL :: western_side, eastern_side, northern_side, southern_side 154 149 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 155 LOGICAL :: western_side, eastern_side, northern_side, southern_side 156 157 !!----------------------------------------------------------------------- 158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 150 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab 151 !!----------------------------------------------------------------------- 152 ! tracers are not multiplied by grid cell here => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy 159 153 ! and it is ok since we conserve tracers (same as in the ocean). 160 154 ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) … … 163 157 jm = 1 164 158 DO jl = 1, jpl 165 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ;jm = jm + 1166 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ;jm = jm + 1167 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ;jm = jm + 1168 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ;jm = jm + 1169 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ;jm = jm + 1159 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 160 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 161 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 162 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 163 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 170 164 DO jk = 1, nlay_s 171 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ;jm = jm + 1172 END DO165 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 166 END DO 173 167 DO jk = 1, nlay_i 174 ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ;jm = jm + 1175 END DO176 END DO168 ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 169 END DO 170 END DO 177 171 178 172 DO jk = k1, k2 179 WHERE( tmask(i1:i2,j1:j2,1) == 0. )ptab(i1:i2,j1:j2,jk) = -9999.180 END DO173 WHERE( tmask(i1:i2,j1:j2,1) == 0._wp ) ptab(i1:i2,j1:j2,jk) = -9999. 174 END DO 181 175 182 176 ELSE ! child grid … … 184 178 jm = 1 185 179 DO jl = 1, jpl 186 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1187 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1188 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1189 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1190 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1180 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 181 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 182 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 183 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 184 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 185 DO jk = 1, nlay_s 192 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1193 END DO186 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 187 END DO 194 188 DO jk = 1, nlay_i 195 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ;jm = jm + 1196 END DO197 END DO189 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 END DO 191 END DO 198 192 199 193 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points … … 319 313 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 314 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 315 ! 322 316 ENDIF 323 317 … … 327 321 328 322 #else 323 !!---------------------------------------------------------------------- 324 !! Empty module no sea-ice 325 !!---------------------------------------------------------------------- 329 326 CONTAINS 330 327 SUBROUTINE agrif_lim3_interp_empty 331 !!---------------------------------------------332 !! *** ROUTINE agrif_lim3_interp_empty ***333 !!---------------------------------------------334 328 WRITE(*,*) 'agrif_lim3_interp : You should not have seen this print! error?' 335 329 END SUBROUTINE agrif_lim3_interp_empty 336 330 #endif 331 332 !!====================================================================== 337 333 END MODULE agrif_lim3_interp
Note: See TracChangeset
for help on using the changeset viewer.
