- Timestamp:
- 2017-10-04T09:19:23+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r8215 r8586 228 228 229 229 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))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)) 232 232 233 233 ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r8215 r8586 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 … … 60 59 REAL(wp) :: zztmp ! - - 61 60 ! 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e363 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs, z3d64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs61 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 65 64 !!---------------------------------------------------------------------- 66 65 ! 67 66 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 68 69 ! Initialize arrays70 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w )71 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v )72 CALL wrk_alloc( jpi,jpj,jpk, zt , zs , z3d )73 !74 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )75 67 76 68 ! Depth work arrrays … … 248 240 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 249 241 250 ! free memory251 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w )252 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v )253 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs )254 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs )255 242 ! 256 243 CALL iom_swap( "nemo" ) ! return back on high-resolution grid -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r6140 r8586 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.