- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r5302 r6808 30 30 !! Original. May 2012. (J. Simeon, C. Calone, G. Madec, C. Ethe) 31 31 !!=================================================================== 32 33 32 USE dom_oce ! ocean space and time domain and to get jperio 34 USE wrk_nemo ! work arrays35 33 USE crs ! domain for coarse grid 34 ! 36 35 USE in_out_manager 37 36 USE par_kind 38 37 USE crslbclnk 38 USE wrk_nemo ! work arrays 39 39 USE lib_mpp 40 41 40 42 41 IMPLICIT NONE … … 54 53 REAL(wp) :: r_inf = 1e+36 55 54 56 !! Substitutions 57 # include "domzgr_substitute.h90" 58 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 59 57 !! $Id$ 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 59 !!---------------------------------------------------------------------- 60 60 CONTAINS 61 62 61 63 62 SUBROUTINE crs_dom_msk … … 133 132 END SUBROUTINE crs_dom_msk 134 133 134 135 135 SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs ) 136 136 !!---------------------------------------------------------------- … … 334 334 !! cd_type = grid type (T,U,V,F) for scale factors; for velocities (U or V) 335 335 !! cd_op = applied operation (SUM, VOL, WGT) 336 !! p_ fse3 = (Optional) parent grid vertical level thickness (fse3u or fse3v)336 !! p_e3 = (Optional) parent grid vertical level thickness (e3u or e3v) 337 337 !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid 338 338 !! p_cfield2d_2 = (Optional) 2D field on coarse grid … … 342 342 !! History. 4 Jun. Write for WGT and scale factors only 343 343 !!---------------------------------------------------------------- 344 !! 345 !! Arguments 346 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V 347 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_mask ! Parent grid U,V mask 348 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1 ! Parent grid U,V scale factors (e1) 349 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e2 ! Parent grid U,V scale factors (e2) 350 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_e3 ! Parent grid vertical level thickness (fse3u, fse3v) 351 352 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity 353 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity 354 355 !! Local variables 356 REAL(wp) :: zdAm 357 INTEGER :: ji, jj, jk , ii, ij, je_2 358 359 REAL(wp), DIMENSION(:,:,:), POINTER :: zvol, zmask 344 CHARACTER(len=1), INTENT(in ) :: cd_type ! grid type U,V 345 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_mask ! Parent grid U,V mask 346 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e1 ! Parent grid U,V scale factors (e1) 347 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e2 ! Parent grid U,V scale factors (e2) 348 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 349 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld1_crs ! Coarse grid box 3D quantity 350 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld2_crs ! Coarse grid box 3D quantity 351 ! 352 INTEGER :: ji, jj, jk , ii, ij, je_2 353 REAL(wp) :: zdAm 354 REAL(wp), DIMENSION(:,:,:), POINTER :: zvol, zmask 360 355 !!---------------------------------------------------------------- 361 362 CALL wrk_alloc( jpi, jpj, jpk,zvol, zmask )363 364 p_fld1_crs(:,:,:) = 0. 0365 p_fld2_crs(:,:,:) = 0. 0356 ! 357 CALL wrk_alloc( jpi,jpj,jpk, zvol, zmask ) 358 ! 359 p_fld1_crs(:,:,:) = 0._wp 360 p_fld2_crs(:,:,:) = 0._wp 366 361 367 362 DO jk = 1, jpk 368 363 zvol(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 369 END DO370 371 zmask(:,:,:) = 0. 0364 END DO 365 366 zmask(:,:,:) = 0._wp 372 367 IF( cd_type == 'W' ) THEN 373 368 zmask(:,:,1) = p_mask(:,:,1) … … 469 464 !! p_pmask = parent grid mask (T,U,V,F) for scale factors; 470 465 !! for velocities (U or V) 471 !! p_ fse3 = parent grid vertical level thickness (fse3u or fse3v)466 !! p_e3 = parent grid vertical level thickness (e3u or e3v) 472 467 !! p_pfield = U or V on the parent grid 473 468 !! p_surf_crs = (Optional) Coarse grid weight for averaging … … 478 473 !! 5 Jun. Streamline for area-weighted average only ; separate scale factor and weights. 479 474 !!---------------------------------------------------------------- 480 !! 481 !! Arguments 482 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_fld ! T, U, V or W on parent grid 483 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN 475 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_fld ! T, U, V or W on parent grid 476 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN 484 477 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V 485 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask486 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)487 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (fse3u, fse3v)478 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask 479 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2) 480 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 488 481 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator 489 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 490 REAL(wp), INTENT(in) :: psgn ! sign 491 492 493 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld_crs ! Coarse grid box 3D quantity 494 495 !! Local variables 496 INTEGER :: ji, jj, jk 497 INTEGER :: ii, ij, ijie, ijje, je_2 498 REAL(wp) :: zflcrs, zsfcrs 499 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask 482 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 483 REAL(wp), INTENT(in) :: psgn ! sign 484 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld_crs ! Coarse grid box 3D quantity 485 ! 486 INTEGER :: ji, jj, jk 487 INTEGER :: ii, ij, ijie, ijje, je_2 488 REAL(wp) :: zflcrs, zsfcrs 489 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask 500 490 !!---------------------------------------------------------------- 501 502 p_fld_crs(:,:,:) = 0. 0503 491 ! 492 p_fld_crs(:,:,:) = 0._wp 493 ! 504 494 SELECT CASE ( cd_op ) 505 506 507 508 CALL wrk_alloc( jpi, jpj, jpk,zsurf, zsurfmsk )509 510 511 512 513 495 ! 496 CASE ( 'VOL' ) 497 ! 498 CALL wrk_alloc( jpi,jpj,jpk, zsurf, zsurfmsk ) 499 ! 500 SELECT CASE ( cd_type ) 501 ! 502 CASE( 'T', 'W' ) 503 IF( cd_type == 'T' ) THEN 514 504 DO jk = 1, jpk 515 505 zsurf (:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) … … 1136 1126 !! p_pmask = parent grid mask (T,U,V,F) for scale factors; 1137 1127 !! for velocities (U or V) 1138 !! p_ fse3 = parent grid vertical level thickness (fse3u or fse3v)1128 !! p_e3 = parent grid vertical level thickness (e3u or e3v) 1139 1129 !! p_pfield = U or V on the parent grid 1140 1130 !! p_surf_crs = (Optional) Coarse grid weight for averaging … … 1145 1135 !! 5 Jun. Streamline for area-weighted average only ; separate scale factor and weights. 1146 1136 !!---------------------------------------------------------------- 1147 !!1148 !! Arguments1149 1137 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: p_fld ! T, U, V or W on parent grid 1150 1138 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN … … 1152 1140 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask 1153 1141 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2) 1154 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness ( fse3u, fse3v)1142 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 1155 1143 REAL(wp), DIMENSION(jpi_crs,jpj_crs) , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator 1156 1144 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V mask 1157 1145 REAL(wp), INTENT(in) :: psgn 1158 1159 1146 REAL(wp), DIMENSION(jpi_crs,jpj_crs) , INTENT(out) :: p_fld_crs ! Coarse grid box 3D quantity 1160 1161 !! Local variables 1147 ! 1162 1148 INTEGER :: ji, jj, jk ! dummy loop indices 1163 1149 INTEGER :: ijie, ijje, ii, ij, je_2 1164 1150 REAL(wp) :: zflcrs, zsfcrs 1165 1151 REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk 1166 1167 1152 !!---------------------------------------------------------------- 1168 1169 p_fld_crs(:,:) = 0. 01170 1153 ! 1154 p_fld_crs(:,:) = 0._wp 1155 ! 1171 1156 SELECT CASE ( cd_op ) 1172 1157
Note: See TracChangeset
for help on using the changeset viewer.