Changeset 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS
- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- Location:
- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS
- Files:
-
- 3 edited
-
crs.F90 (modified) (4 diffs)
-
crsfld.F90 (modified) (7 diffs)
-
crslbclnk.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r6140 r8882 140 140 ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 141 141 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tsn_crs 142 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: un_crs, vn_crs, wn_crs , rke_crs142 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: un_crs, vn_crs, wn_crs 143 143 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: hdivn_crs 144 144 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: sshn_crs … … 151 151 152 152 ! Vertical diffusion 153 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_crs !: vert. diffusivity coef. [m2/s] at w-point for temp 154 # if defined key_zdfddm 155 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point 156 # endif 153 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_crs !: temperature vertical diffusivity coeff. [m2/s] at w-point 154 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point 157 155 158 156 ! Mixing and Mixed Layer Depth … … 230 228 231 229 232 ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , & 233 & wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),& 234 & rke_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(11)) 230 ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs (jpi_crs,jpj_crs,jpk) , & 231 & wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(11)) 235 232 236 233 ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & … … 239 236 & fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) ) 240 237 241 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), & 242 # if defined key_zdfddm 243 & avs_crs(jpi_crs,jpj_crs,jpk), & 244 # endif 245 & STAT=ierr(13) ) 238 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), & 239 & avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) ) 246 240 247 241 ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & 248 242 & hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 249 243 250 ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), & 251 & nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij), & 252 njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), & 253 & njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij) , STAT=ierr(15) ) 254 255 244 ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij), & 245 & nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij), & 246 njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij), & 247 & njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij) , STAT=ierr(15) ) 248 256 249 crs_dom_alloc = MAXVAL(ierr) 257 250 ! 258 251 END FUNCTION crs_dom_alloc 259 252 -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r6140 r8882 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 26 USE timing ! preformance summary 27 USE wrk_nemo ! working array28 27 29 28 IMPLICIT NONE … … 58 57 INTEGER :: ji, jj, jk ! dummy loop indices 59 58 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 60 ! 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs 59 REAL(wp) :: zztmp ! - - 60 ! 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt , zs , z3d 63 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zt_crs, zs_crs 64 64 !!---------------------------------------------------------------------- 65 65 ! 66 66 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 67 68 ! Initialize arrays69 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w )70 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v )71 CALL wrk_alloc( jpi,jpj,jpk, zt , zs )72 !73 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )74 67 75 68 ! Depth work arrrays … … 84 77 vn_crs (:,:,: ) = 0._wp ! v-velocity 85 78 wn_crs (:,:,: ) = 0._wp ! w 86 av t_crs (:,:,: ) = 0._wp ! avt79 avs_crs (:,:,: ) = 0._wp ! avt 87 80 hdivn_crs(:,:,: ) = 0._wp ! hdiv 88 rke_crs (:,:,: ) = 0._wp ! rke89 81 sshn_crs (:,: ) = 0._wp ! ssh 90 82 utau_crs (:,: ) = 0._wp ! taux … … 158 150 CALL iom_put( "voces" , zs_crs ) ! vS 159 151 160 161 ! Kinetic energy 162 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 163 CALL iom_put( "eken", rke_crs ) 164 152 IF( iom_use( "eken") ) THEN ! kinetic energy 153 z3d(:,:,jk) = 0._wp 154 DO jk = 1, jpkm1 155 DO jj = 2, jpjm1 156 DO ji = fs_2, fs_jpim1 ! vector opt. 157 zztmp = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 158 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & 159 & un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 160 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 161 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 162 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 163 END DO 164 END DO 165 END DO 166 CALL lbc_lnk( z3d, 'T', 1. ) 167 ! 168 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 169 CALL iom_put( "eken", zt_crs ) 170 ENDIF 165 171 ! Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 166 172 DO jk = 1, jpkm1 … … 175 181 hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 176 182 ENDIF 177 END DO178 END DO179 END DO183 END DO 184 END DO 185 END DO 180 186 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) 181 187 ! … … 196 202 ! free memory 197 203 198 ! avt, avs 199 !!gm BUG TOP always uses avs !!! 204 ! avs 200 205 SELECT CASE ( nn_crs_kz ) 201 206 CASE ( 0 ) 202 207 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 208 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 203 209 CASE ( 1 ) 204 210 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 211 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 205 212 CASE ( 2 ) 206 213 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 214 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 207 215 END SELECT 208 216 ! 209 CALL iom_put( "avt", avt_crs ) ! Kz 217 CALL iom_put( "avt", avt_crs ) ! Kz on T 218 CALL iom_put( "avs", avs_crs ) ! Kz on S 210 219 211 220 ! sbc fields … … 231 240 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 232 241 233 ! free memory234 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w )235 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v )236 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs )237 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )238 242 ! 239 243 CALL iom_swap( "nemo" ) ! return back on high-resolution grid -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r6140 r8882 15 15 16 16 INTERFACE crs_lbc_lnk 17 MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_ 3d_gather, crs_lbc_lnk_2d17 MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d 18 18 END INTERFACE 19 19 … … 49 49 ll_grid_crs = ( jpi == jpi_crs ) 50 50 ! 51 IF( PRESENT(pval) ) THEN ;zval = pval52 ELSE ;zval = 0._wp51 IF( PRESENT(pval) ) THEN ; zval = pval 52 ELSE ; zval = 0._wp 53 53 ENDIF 54 54 ! 55 55 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 56 56 ! 57 IF( PRESENT( cd_mpp ) ) THEN ;CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval )58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval )57 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval ) 58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn , pval=zval ) 59 59 ENDIF 60 60 ! … … 62 62 ! 63 63 END SUBROUTINE crs_lbc_lnk_3d 64 65 66 SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )67 !!---------------------------------------------------------------------68 !! *** SUBROUTINE crs_lbc_lnk ***69 !!70 !! ** Purpose : set lateral boundary conditions for coarsened grid71 !!72 !! ** Method : Swap domain indices from full to coarse domain73 !! before arguments are passed directly to lbc_lnk.74 !! Upon exiting, switch back to full domain indices.75 !!----------------------------------------------------------------------76 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! grid type77 REAL(wp) , INTENT(in ) :: psgn ! control of the sign78 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied79 !80 LOGICAL :: ll_grid_crs81 !!----------------------------------------------------------------------82 !83 ll_grid_crs = ( jpi == jpi_crs )84 !85 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain86 !87 CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn )88 !89 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain90 !91 END SUBROUTINE crs_lbc_lnk_3d_gather92 93 64 94 65 … … 115 86 ll_grid_crs = ( jpi == jpi_crs ) 116 87 ! 117 IF( PRESENT(pval) ) THEN ;zval = pval118 ELSE ;zval = 0._wp88 IF( PRESENT(pval) ) THEN ; zval = pval 89 ELSE ; zval = 0._wp 119 90 ENDIF 120 91 ! 121 92 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 122 93 ! 123 IF( PRESENT( cd_mpp ) ) THEN ;CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval )124 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval )94 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval ) 95 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn , pval=zval ) 125 96 ENDIF 126 97 !
Note: See TracChangeset
for help on using the changeset viewer.
